Avanzado – Página 3

Número de sumandos en suma de cuadrados

PorJosé A. Alonso 21-febrero-201926-marzo-2022

El teorema de Lagrange de los cuatro cuadrados asegura que cualquier número entero positivo es la suma de, como máximo,cuatro cuadrados de números enteros. Por ejemplo,

   16 = 4²
   29 = 2² + 5²  
   14 = 1² + 2² + 3²
   15 = 1² + 1² + 2² + 3²

16 = 4²

29 = 2² + 5²

14 = 1² + 2² + 3²

15 = 1² + 1² + 2² + 3²

Definir las funciones

   ordenLagrange        :: Integer -> Int
   graficaOrdenLagrange :: Integer -> IO ()

1 2	ordenLagrange :: Integer -> Int graficaOrdenLagrange :: Integer -> IO ()

tales que

(ordenLagrange n) es el menor número de cuadrados necesarios para escribir n como suma de cuadrados. Por ejemplo.

     ordenLagrange 16     ==  1
     ordenLagrange 29     ==  2
     ordenLagrange 14     ==  3
     ordenLagrange 15     ==  4
     ordenLagrange 10000  ==  1
     ordenLagrange 10001  ==  2
     ordenLagrange 10002  ==  3
     ordenLagrange 10007  ==  4

ordenLagrange 16 == 1

ordenLagrange 29 == 2

ordenLagrange 14 == 3

ordenLagrange 15 == 4

ordenLagrange 10000 == 1

ordenLagrange 10001 == 2

ordenLagrange 10002 == 3

ordenLagrange 10007 == 4

(graficaOrdenLagrange n) dibuja la gráfica de los órdenes de Lagrange de los n primeros números naturales. Por ejemplo, (graficaOrdenLagrange 100) dibuja

Comprobar con QuickCheck que. para todo entero positivo k, el orden de Lagrange de k es menos o igual que 4, el de 4k+3 es distinto de 2 y el de 8k+7 es distinto de 3.

Soluciones

import Data.Array (Array, (!), array)
import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

ordenLagrange :: Integer -> Int
ordenLagrange n
  | esCuadrado n = 1
  | otherwise    = 1 + minimum [ ordenLagrange (n - x^2)
                               | x <- [1..raizEntera n]]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = (raizEntera x)^2 == x

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

ordenLagrange2 :: Integer -> Int
ordenLagrange2 n = (vectorOrdenLagrange n) ! n

vectorOrdenLagrange :: Integer -> Array Integer Int
vectorOrdenLagrange n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f i | esCuadrado i = 1
      | otherwise    = 1 + minimum [ v ! (i - j^2)
                                   | j <- [1..raizEntera i]]

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

-- La comparación es
--    λ> ordenLagrange 50
--    2
--    (10.39 secs, 1,704,144,464 bytes)
--    λ> ordenLagrange2 50
--    2
--    (0.01 secs, 341,920 bytes)

-- Definición de graficaOrdenLagrange
-- ==================================

graficaOrdenLagrange :: Integer -> IO ()
graficaOrdenLagrange n = 
  plotList [ Key Nothing
           , PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")
           ]
           (map ordenLagrange2 [0..n-1])

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

-- La propiedad es
prop_OrdenLagrange :: Positive Integer -> Bool
prop_OrdenLagrange (Positive k) =
  ordenLagrange2 k <= 4 &&
  ordenLagrange2 (4*k+3) /= 2 &&
  ordenLagrange2 (8*k+7) /= 3

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

import Data.Array (Array, (!), array)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

ordenLagrange :: Integer -> Int

ordenLagrange n

| esCuadrado n = 1

| otherwise = 1 + minimum [ ordenLagrange (n - x^2)

| x <- [1..raizEntera n]]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

esCuadrado x = (raizEntera x)^2 == x

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª definición

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

ordenLagrange2 :: Integer -> Int

ordenLagrange2 n = (vectorOrdenLagrange n) ! n

vectorOrdenLagrange :: Integer -> Array Integer Int

vectorOrdenLagrange n = v where

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

f i | esCuadrado i = 1

| otherwise = 1 + minimum [ v ! (i - j^2)

| j <- [1..raizEntera i]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenLagrange 50

-- 2

-- (10.39 secs, 1,704,144,464 bytes)

-- λ> ordenLagrange2 50

-- 2

-- (0.01 secs, 341,920 bytes)

-- Definición de graficaOrdenLagrange

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

graficaOrdenLagrange :: Integer -> IO ()

graficaOrdenLagrange n =

plotList [ Key Nothing

, PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")

]

(map ordenLagrange2 [0..n-1])

-- Comprobación de la propiedad

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

-- La propiedad es

prop_OrdenLagrange :: Positive Integer -> Bool

prop_OrdenLagrange (Positive k) =

ordenLagrange2 k <= 4 &&

ordenLagrange2 (4*k+3) /= 2 &&

ordenLagrange2 (8*k+7) /= 3

-- La comprobación es

-- λ> quickCheck prop_OrdenLagrange

-- +++ OK, passed 100 tests.

Pensamiento

— Nuestro español bosteza.
¿Es hambre? ¿Sueño? ¿Hastío?
Doctor, ¿tendrá el estómago vacío?
— El vacío es más bien en la cabeza.

Antonio Machado

Simplificación de expresiones booleanas

PorJosé A. Alonso 14-febrero-201921-febrero-2019

El siguiente tipo de dato algebraico representa las expresiones booleanas construidas con una variable (X), las constantes verdadera (V) y falsa (F), la negación (Neg) y la disyunción (Dis):

   data Expr = X
             | V
             | F
             | Neg Expr
             | Dis Expr Expr
             deriving (Eq, Ord)

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord)

Por ejemplo, la fórmula (¬X v V) se representa por (Dis (Neg X) V).

Definir las funciones

   valor      :: Expr -> Bool -> Bool 
   simplifica :: Expr -> Expr

1 2	valor :: Expr -> Bool -> Bool simplifica :: Expr -> Expr

tales que (valor p i) es el valor de la fórmula p cuando se le asigna a X el valor i. Por ejemplo,

   valor (Neg X) True           ==  False
   valor (Neg F) True           ==  True
   valor (Dis X (Neg X)) True   ==  True
   valor (Dis X (Neg X)) False  ==  True

valor (Neg X) True == False

valor (Neg F) True == True

valor (Dis X (Neg X)) True == True

valor (Dis X (Neg X)) False == True

y (simplifica p) es una expresión obtenida aplicándole a p las siguientes reglas de simplificación:

   Neg V       = F
   Neg F       = V
   Neg (Neg q) = q
   Dis V q     = V
   Dis F q     = q
   Dis q V     = V
   Dis q F     = F
   Dis q q     = q

Neg V = F

Neg F = V

Neg (Neg q) = q

Dis V q = V

Dis F q = q

Dis q V = V

Dis q F = F

Dis q q = q

Por ejemplo,

   simplifica (Dis X (Neg (Neg X)))                      ==  X
   simplifica (Neg (Dis (Neg (Neg X)) F))                ==  Neg X
   simplifica (Dis (Neg F) F)                            ==  V
   simplifica (Dis (Neg V) (Neg (Dis (Neg X) F)))        ==  X
   simplifica (Dis (Neg V) (Neg (Dis (Neg (Neg X)) F)))  ==  Neg X

simplifica (Dis X (Neg (Neg X))) == X

simplifica (Neg (Dis (Neg (Neg X)) F)) == Neg X

simplifica (Dis (Neg F) F) == V

simplifica (Dis (Neg V) (Neg (Dis (Neg X) F))) == X

simplifica (Dis (Neg V) (Neg (Dis (Neg (Neg X)) F))) == Neg X

Comprobar con QuickCheck que para cualquier fórmula p y cualquier booleano i se verifica que (valor (simplifica p) i) es igual a (valor p i).

Para la comprobación, de define el generador

   instance Arbitrary Expr where
     arbitrary = sized expr
       where expr n | n <= 0    = atom
                    | otherwise = oneof [ atom
                                        , liftM Neg subexpr
                                        , liftM2 Dis subexpr subexpr ]
               where atom    = oneof [elements [X,V,F]]
                     subexpr = expr (n `div` 2)

instance Arbitrary Expr where

arbitrary = sized expr

where expr n | n <= 0 = atom

| otherwise = oneof [ atom

, liftM Neg subexpr

, liftM2 Dis subexpr subexpr ]

where atom = oneof [elements [X,V,F]]

subexpr = expr (n `div` 2)

que usa las funciones liftM y liftM2 de la librería Control.Monad que hay que importar al principio.

Soluciones

import Test.QuickCheck
import Control.Monad 

data Expr = X
          | V
          | F
          | Neg Expr
          | Dis Expr Expr
          deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool 
valor X i         = i
valor V _         = True
valor F _         = False
valor (Neg p) i   = not (valor p i)
valor (Dis p q) i = valor p i || valor q i

simplifica :: Expr -> Expr
simplifica X = X
simplifica V = V
simplifica F = F
simplifica (Neg p) = negacion (simplifica p)
  where negacion V       = F
        negacion F       = V
        negacion (Neg p) = p
        negacion p       = Neg p
simplifica (Dis p q) = disyuncion (simplifica p) (simplifica q)
  where disyuncion V q = V
        disyuncion F q = q
        disyuncion q V = V
        disyuncion q F = q
        disyuncion p q | p == q    = p
                       | otherwise = Dis p q

-- La propiedad es
prop_simplifica :: Expr -> Bool -> Bool
prop_simplifica p i =
  valor (simplifica p) i == valor p i

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

-- Generador de fórmulas
instance Arbitrary Expr where
  arbitrary = sized expr
    where expr n | n <= 0    = atom
                 | otherwise = oneof [ atom
                                     , liftM Neg subexpr
                                     , liftM2 Dis subexpr subexpr ]
            where atom    = oneof [elements [X,V,F]]
                  subexpr = expr (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = X

| V

| F

| Neg Expr

| Dis Expr Expr

deriving (Eq, Ord, Show)

valor :: Expr -> Bool -> Bool

valor X i = i

valor V _ = True

valor F _ = False

valor (Neg p) i = not (valor p i)

valor (Dis p q) i = valor p i || valor q i

simplifica :: Expr -> Expr

simplifica X = X

simplifica V = V

simplifica F = F

simplifica (Neg p) = negacion (simplifica p)

where negacion V = F

negacion F = V

negacion (Neg p) = p

negacion p = Neg p

simplifica (Dis p q) = disyuncion (simplifica p) (simplifica q)

where disyuncion V q = V

disyuncion F q = q

disyuncion q V = V

disyuncion q F = q

disyuncion p q | p == q = p

| otherwise = Dis p q

-- La propiedad es

prop_simplifica :: Expr -> Bool -> Bool

prop_simplifica p i =

valor (simplifica p) i == valor p i

-- La comprobación es

-- λ> quickCheck prop_simplifica

-- +++ OK, passed 100 tests.

-- Generador de fórmulas

instance Arbitrary Expr where

arbitrary = sized expr

where expr n | n <= 0 = atom

| otherwise = oneof [ atom

, liftM Neg subexpr

, liftM2 Dis subexpr subexpr ]

where atom = oneof [elements [X,V,F]]

subexpr = expr (n `div` 2)

Pensamiento

¿Dices que nada se pierde?
Si esta copa de cristal
se me rompe, nunca en ella
beberé, nunca jamás.

Antonio Machado

Árboles con n elementos

PorJosé A. Alonso 29-enero-20195-febrero-2019

Los árboles binarios se pueden representar con

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
     deriving (Show, Eq)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

Definir las funciones

   arboles  :: Integer -> a -> [Arbol a]
   nArboles :: [Integer]

1 2	arboles :: Integer -> a -> [Arbol a] nArboles :: [Integer]

tales que

(arboles n x) es la lista de todos los árboles binarios con n elementos iguales a x. Por ejemplo,

     λ> arboles 0 7
     []
     λ> arboles 1 7
     [H 7]
     λ> arboles 2 7
     []
     λ> arboles 3 7
     [N 7 (H 7) (H 7)]
     λ> arboles 4 7
     []
     λ> arboles 5 7
     [N 7 (H 7) (N 7 (H 7) (H 7)),N 7 (N 7 (H 7) (H 7)) (H 7)]
     λ> arboles 6 7
     []
     λ> arboles 7 7
     [N 7 (H 7) (N 7 (H 7) (N 7 (H 7) (H 7))),
      N 7 (H 7) (N 7 (N 7 (H 7) (H 7)) (H 7)),
      N 7 (N 7 (H 7) (H 7)) (N 7 (H 7) (H 7)),
      N 7 (N 7 (H 7) (N 7 (H 7) (H 7))) (H 7),
      N 7 (N 7 (N 7 (H 7) (H 7)) (H 7)) (H 7)]

λ> arboles 0 7

[]

λ> arboles 1 7

[H 7]

λ> arboles 2 7

[]

λ> arboles 3 7

[N 7 (H 7) (H 7)]

λ> arboles 4 7

[]

λ> arboles 5 7

[N 7 (H 7) (N 7 (H 7) (H 7)),N 7 (N 7 (H 7) (H 7)) (H 7)]

λ> arboles 6 7

[]

λ> arboles 7 7

[N 7 (H 7) (N 7 (H 7) (N 7 (H 7) (H 7))),

N 7 (H 7) (N 7 (N 7 (H 7) (H 7)) (H 7)),

N 7 (N 7 (H 7) (H 7)) (N 7 (H 7) (H 7)),

N 7 (N 7 (H 7) (N 7 (H 7) (H 7))) (H 7),

N 7 (N 7 (N 7 (H 7) (H 7)) (H 7)) (H 7)]

nArboles es la sucesión de los números de árboles con k elementos iguales a 7, con k ∈ {1,3,5,…}. Por ejemplo,

     λ> take 14 nArboles
     [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]
     λ> nArboles !! 100
     896519947090131496687170070074100632420837521538745909320
     λ> length (show (nArboles !! 1000))
     598

λ> take 14 nArboles

[1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]

λ> nArboles !! 100

896519947090131496687170070074100632420837521538745909320

λ> length (show (nArboles !! 1000))

598

Soluciones

import Data.List (genericLength)

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving (Show, Eq)

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

arboles :: Integer -> a -> [Arbol a]
arboles 0 _ = []
arboles 1 x = [H x]
arboles n x = [N x i d | k <- [0..n-1],
                         i <- arboles k x,
                         d <- arboles (n-1-k) x]

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

arboles2 :: Integer -> a -> [Arbol a]
arboles2 0 _ = []
arboles2 1 x = [H x]
arboles2 n x = [N x i d | k <- [1,3..n-1],
                          i <- arboles2 k x,
                          d <- arboles2 (n-1-k) x]
  
-- 1ª definición de nArboles
-- =========================

nArboles :: [Integer]
nArboles = [genericLength (arboles2 n 7) | n <- [1,3..]]

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

-- Con la definición anterior se observa que nArboles es
--    1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900
-- son los números de Catalan https://en.wikipedia.org/wiki/Catalan_number
-- Una forma de calcularlos (ver https://oeis.org/A000108) es
--     (2n)!/(n!(n+1)!)

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

factorial :: Integer -> Integer
factorial n = product [1..n]

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

-- 1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900

--  1
--  1 = 1*1
--  2 = 1*1  + 1*1
--  5 = 1*2  + 1*1 + 2*1
-- 14 = 1*5  + 1*2 + 2*1 + 5*1 
-- 42 = 1*14 + 1*5 + 2*2 + 5*1 + 14*1

nArboles3 :: [Integer]
nArboles3 = 1 : aux [1]
  where aux cs = c : aux (c:cs)
          where c = sum (zipWith (*) cs (reverse cs))  

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

--    λ> length (show (nArboles !! 12))
--    6
--    (6.50 secs, 1,060,563,128 bytes)
--    λ> length (show (nArboles2 !! 12))
--    6
--    (0.01 secs, 108,520 bytes)
--    λ> length (show (nArboles3 !! 12))
--    6
--    (0.01 secs, 119,096 bytes)
--
--    λ> length (show (nArboles2 !! 1000))
--    598
--    (0.01 secs, 4,796,440 bytes)
--    λ> length (show (nArboles3 !! 1000))
--    598
--    (1.66 secs, 321,771,704 bytes)

import Data.List (genericLength)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

-- 1ª definición de arboles

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

arboles :: Integer -> a -> [Arbol a]

arboles 0 _ = []

arboles 1 x = [H x]

arboles n x = [N x i d | k <- [0..n-1],

i <- arboles k x,

d <- arboles (n-1-k) x]

-- 2ª definición de arboles

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

arboles2 :: Integer -> a -> [Arbol a]

arboles2 0 _ = []

arboles2 1 x = [H x]

arboles2 n x = [N x i d | k <- [1,3..n-1],

i <- arboles2 k x,

d <- arboles2 (n-1-k) x]

-- 1ª definición de nArboles

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

nArboles :: [Integer]

nArboles = [genericLength (arboles2 n 7) | n <- [1,3..]]

-- 2ª definición de nArboles

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

-- Con la definición anterior se observa que nArboles es

-- 1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900

-- son los números de Catalan https://en.wikipedia.org/wiki/Catalan_number

-- Una forma de calcularlos (ver https://oeis.org/A000108) es

-- (2n)!/(n!(n+1)!)

nArboles2 :: [Integer]

nArboles2 =

[factorial (2*n) `div` (factorial n * factorial (n+1)) | n <- [0..]]

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 3ª definición de nArboles

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

-- 1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900

-- 1

-- 1 = 1*1

-- 2 = 1*1 + 1*1

-- 5 = 1*2 + 1*1 + 2*1

-- 14 = 1*5 + 1*2 + 2*1 + 5*1

-- 42 = 1*14 + 1*5 + 2*2 + 5*1 + 14*1

nArboles3 :: [Integer]

nArboles3 = 1 : aux [1]

where aux cs = c : aux (c:cs)

where c = sum (zipWith (*) cs (reverse cs))

-- Comparación de eficiencia

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

-- λ> length (show (nArboles !! 12))

-- 6

-- (6.50 secs, 1,060,563,128 bytes)

-- λ> length (show (nArboles2 !! 12))

-- 6

-- (0.01 secs, 108,520 bytes)

-- λ> length (show (nArboles3 !! 12))

-- 6

-- (0.01 secs, 119,096 bytes)

-- λ> length (show (nArboles2 !! 1000))

-- 598

-- (0.01 secs, 4,796,440 bytes)

-- λ> length (show (nArboles3 !! 1000))

-- 598

-- (1.66 secs, 321,771,704 bytes)

Pensamiento

Ni vale nada el fruto
cogido sin sazón …
Ni aunque te elogie un bruto
ha de tener razón.

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

Posiciones del 2019 en el número pi

PorJosé A. Alonso 17-enero-201924-enero-2019

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posiciones :: String -> Int -> IO [Int]

1	posiciones :: String -> Int -> IO [Int]

tal que (posicion cs k) es es la lista de las posiciones iniciales de cs en la sucesión formada por los k primeros dígitos decimales del número pi. Por ejemplo,

   λ> posiciones "141" 1000
   [0,294]
   λ> posiciones "4159" 10000
   [1,5797,6955,9599]

λ> posiciones "141" 1000

[0,294]

λ> posiciones "4159" 10000

[1,5797,6955,9599]

Calcular la primera posición de 2019 en los decimales de pi y el número de veces que aparece 2019 en en el primer millón de decimales de pi.

Soluciones

import Data.List ( isPrefixOf
                 , findIndices
                 , tails  
                 )

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

posiciones :: String -> Int -> IO [Int]
posiciones cs k = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionesEnLista cs (take (k-1) (drop 2 ds)))

--    posicionesEnLista "23" "234235523"  ==  [0,3,7]
posicionesEnLista :: Eq a => [a] -> [a] -> [Int]
posicionesEnLista xs ys = reverse (aux ys 0 [])
  where aux []      _ ns = ns
        aux (y:ys') n ns | xs `isPrefixOf` (y:ys') = aux ys' (n+1) (n:ns)
                         | otherwise               = aux ys' (n+1) ns

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

posiciones2 :: String -> Int -> IO [Int]
posiciones2 cs k = do
  ds <- readFile "Digitos_de_pi.txt"
  return (findIndices (cs `isPrefixOf`) (tails (take (k-1) (drop 2 ds))))

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

--    λ> length <$> posiciones "2019" (10^6)
--    112
--    (1.73 secs, 352,481,272 bytes)
--    λ> length <$> posiciones2 "2019" (10^6)
--    112
--    (0.16 secs, 144,476,384 bytes)

-- El cálculo es
--    λ> ps <- posiciones "2019" (10^6)
--    λ> head ps
--    243
--    λ> length ps
--    112
-- Por tanto, la posición de la primera ocurrencia es 243 y hay 112
-- ocurrencias. Otra forma de hacer los cálculos anteriores es
--    λ> head <$> posiciones "2019" (10^6)
--    243
--    λ> length <$> posiciones "2019" (10^6)
--    112

import Data.List ( isPrefixOf

, findIndices

, tails

)

-- 1ª definición

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

posiciones :: String -> Int -> IO [Int]

posiciones cs k = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionesEnLista cs (take (k-1) (drop 2 ds)))

-- posicionesEnLista "23" "234235523" == [0,3,7]

posicionesEnLista :: Eq a => [a] -> [a] -> [Int]

posicionesEnLista xs ys = reverse (aux ys 0 [])

where aux [] _ ns = ns

aux (y:ys') n ns | xs `isPrefixOf` (y:ys') = aux ys' (n+1) (n:ns)

| otherwise = aux ys' (n+1) ns

-- 2ª definición

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

posiciones2 :: String -> Int -> IO [Int]

posiciones2 cs k = do

ds <- readFile "Digitos_de_pi.txt"

return (findIndices (cs `isPrefixOf`) (tails (take (k-1) (drop 2 ds))))

-- Comparación de eficiencia

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

-- λ> length <$> posiciones "2019" (10^6)

-- 112

-- (1.73 secs, 352,481,272 bytes)

-- λ> length <$> posiciones2 "2019" (10^6)

-- 112

-- (0.16 secs, 144,476,384 bytes)

-- El cálculo es

-- λ> ps <- posiciones "2019" (10^6)

-- λ> head ps

-- 243

-- λ> length ps

-- 112

-- Por tanto, la posición de la primera ocurrencia es 243 y hay 112

-- ocurrencias. Otra forma de hacer los cálculos anteriores es

-- λ> head <$> posiciones "2019" (10^6)

-- 243

-- λ> length <$> posiciones "2019" (10^6)

-- 112

Pensamiento

Aprendió tantas cosas, que no tuvo tiempo para pensar en ninguna de ellas.

Antonio Machado

Representación de conjuntos mediante intervalos

PorJosé A. Alonso 15-enero-201922-enero-2019

Un conjunto de números enteros se pueden representar mediante una lista ordenada de intervalos tales que la diferencia entre el menor elemento de un intervalo y el mayor elemento de su intervalo anterior es mayor que uno.

Por ejemplo, el conjunto {2, 7, 4, 3, 9, 6} se puede representar mediante la lista de intervalos [(2,4),(6,7),(9,9)] de forma que en el primer intervalo se agrupan los números 2, 3 y 4; en el segundo, los números 6 y 7 y el tercero, el número 9.

Definir la función

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

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

tal que (intervalos xs) es lista ordenada de intervalos que representa
al conjunto xs. Por ejemplo,

   λ> intervalos [2,7,4,3,9,6]
   [(2,4),(6,7),(9,9)]
   λ> intervalos [180,141,174,143,142,175]
   [(141,143),(174,175),(180,180)]

λ> intervalos [2,7,4,3,9,6]

[(2,4),(6,7),(9,9)]

λ> intervalos [180,141,174,143,142,175]

[(141,143),(174,175),(180,180)]

Soluciones

import Data.List (sort)

intervalos :: [Int] -> [(Int,Int)]
intervalos = map intervalo . segmentos

-- (segmentos xs) es la lista de segmentos formados por elementos
-- consecutivos de xs. Por ejemplo,
--    segmentos [2,7,4,3,9,6]  ==  [[2,3,4],[6,7],[9]]
segmentos :: [Int] -> [[Int]]
segmentos xs = aux as [[a]]
  where aux [] zs = zs
        aux (y:ys) ((a:as):zs) | y == a-1  = aux ys ((y:a:as):zs)
                               | otherwise = aux ys ([y]:(a:as):zs)
        (a:as) = reverse (sort xs)

-- (intervalo xs) es el intervalo correspondiente al segmento xs. Por
-- ejemplo, 
--    intervalo [2,3,4]  ==  (2,4)
--    intervalo [6,7]    ==  (6,7)
--    intervalo [9]      ==  (9,9)
intervalo :: [Int] -> (Int,Int)
intervalo xs = (head xs, last xs)

import Data.List (sort)

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

intervalos = map intervalo . segmentos

-- (segmentos xs) es la lista de segmentos formados por elementos

-- consecutivos de xs. Por ejemplo,

-- segmentos [2,7,4,3,9,6] == [[2,3,4],[6,7],[9]]

segmentos :: [Int] -> [[Int]]

segmentos xs = aux as [[a]]

where aux [] zs = zs

aux (y:ys) ((a:as):zs) | y == a-1 = aux ys ((y:a:as):zs)

| otherwise = aux ys ([y]:(a:as):zs)

(a:as) = reverse (sort xs)

-- (intervalo xs) es el intervalo correspondiente al segmento xs. Por

-- ejemplo,

-- intervalo [2,3,4] == (2,4)

-- intervalo [6,7] == (6,7)

-- intervalo [9] == (9,9)

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

intervalo xs = (head xs, last xs)

Pensamiento

Cuando el saber se especializa, crece el volumen total de la cultura. Esta es la ilusión y el consuelo de los especialistas. ¡Lo que sabemos entre todos! ¡Oh, eso es lo que no sabe nadie!

Antonio Machado

Cadena descendiente de subnúmeros

PorJosé A. Alonso 7-enero-201914-enero-2019

Una particularidad del 2019 es que se puede escribir como una cadena de dos subnúmeros consecutivos (el 20 y el 19).

Definir la función

   cadena :: Integer -> [Integer]

1	cadena :: Integer -> [Integer]

tal que (cadena n) es la cadena de subnúmeros consecutivos de n cuya unión es n; es decir, es la lista de números [x,x-1,…x-k] tal que su concatenación es n. Por ejemplo,

   cadena 2019         == [20,19]
   cadena 2018         == [2018]
   cadena 1009         == [1009]
   cadena 110109       == [110,109]
   cadena 201200199198 == [201,200,199,198] 
   cadena 3246         == [3246]            
   cadena 87654        == [8,7,6,5,4]       
   cadena 123456       == [123456]          
   cadena 1009998      == [100,99,98]       
   cadena 100908       == [100908]          
   cadena 1110987      == [11,10,9,8,7]     
   cadena 210          == [2,1,0]           
   cadena 1            == [1]               
   cadena 0            == [0]               
   cadena 312          == [312]             
   cadena 191          == [191]
   length (cadena (read (concatMap show [2019,2018..0])))  ==  2020

cadena 2019 == [20,19]

cadena 2018 == [2018]

cadena 1009 == [1009]

cadena 110109 == [110,109]

cadena 201200199198 == [201,200,199,198]

cadena 3246 == [3246]

cadena 87654 == [8,7,6,5,4]

cadena 123456 == [123456]

cadena 1009998 == [100,99,98]

cadena 100908 == [100908]

cadena 1110987 == [11,10,9,8,7]

cadena 210 == [2,1,0]

cadena 1 == [1]

cadena 0 == [0]

cadena 312 == [312]

cadena 191 == [191]

length (cadena (read (concatMap show [2019,2018..0]))) == 2020

Nota: Los subnúmeros no pueden empezar por cero. Por ejemplo, [10,09] no es una cadena de 1009 como se observa en el tercer ejemplo.

Soluciones

import Test.QuickCheck
import Data.List (inits)

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

cadena :: Integer -> [Integer]
cadena = head . cadenasL . digitos

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

-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos
-- son xs. Por ejemplo,
--    cadenasL [2,0,1,9]      == [[20,19],[2019]]
--    cadenasL [1,0,0,9]      == [[1009]]
--    cadenasL [1,1,0,1,0,9]  == [[110,109],[110109]]
cadenasL :: [Integer] -> [[Integer]] 
cadenasL []       = []
cadenasL [x]      = [[x]]
cadenasL [1,0]    = [[1,0],[10]]
cadenasL (x:0:zs) = cadenasL (10*x:zs) 
cadenasL (x:y:zs) =
     [x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]
  ++ cadenasL (10*x+y:zs)

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

cadena2 :: Integer -> [Integer]
cadena2 n = (head . concatMap aux . iniciales) n 
  where aux x = [[x,x-1..x-k] | k <- [0..x]
                              , concatMap show [x,x-1..x-k] == ds]
        ds    = show n

-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por
-- ejemplo, 
--    iniciales 2019  ==  [2,20,201,2019]
iniciales :: Integer -> [Integer]
iniciales = map read . tail . inits . show

-- Equivalencia
-- ============

-- La propiedad es
prop_cadena :: (Positive Integer) -> Bool
prop_cadena (Positive n) =
  cadena n == cadena2 n 
  
-- La comprobación es
--    λ> quickCheck prop_cadena
--    +++ OK, passed 100 tests.

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

--    λ> length (cadena (read (concatMap show [15,14..0])))
--    16
--    (3.28 secs, 452,846,008 bytes)
--    λ> length (cadena2 (read (concatMap show [15,14..0])))
--    16
--    (0.03 secs, 176,360 bytes)

import Test.QuickCheck

import Data.List (inits)

-- 1ª solución

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

cadena :: Integer -> [Integer]

cadena = head . cadenasL . digitos

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

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

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

-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos

-- son xs. Por ejemplo,

-- cadenasL [2,0,1,9] == [[20,19],[2019]]

-- cadenasL [1,0,0,9] == [[1009]]

-- cadenasL [1,1,0,1,0,9] == [[110,109],[110109]]

cadenasL :: [Integer] -> [[Integer]]

cadenasL [] = []

cadenasL [x] = [[x]]

cadenasL [1,0] = [[1,0],[10]]

cadenasL (x:0:zs) = cadenasL (10*x:zs)

cadenasL (x:y:zs) =

[x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]

++ cadenasL (10*x+y:zs)

-- 2ª solución

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

cadena2 :: Integer -> [Integer]

cadena2 n = (head . concatMap aux . iniciales) n

where aux x = [[x,x-1..x-k] | k <- [0..x]

, concatMap show [x,x-1..x-k] == ds]

ds = show n

-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por

-- ejemplo,

-- iniciales 2019 == [2,20,201,2019]

iniciales :: Integer -> [Integer]

iniciales = map read . tail . inits . show

-- Equivalencia

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

-- La propiedad es

prop_cadena :: (Positive Integer) -> Bool

prop_cadena (Positive n) =

cadena n == cadena2 n

-- La comprobación es

-- λ> quickCheck prop_cadena

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (cadena (read (concatMap show [15,14..0])))

-- 16

-- (3.28 secs, 452,846,008 bytes)

-- λ> length (cadena2 (read (concatMap show [15,14..0])))

-- 16

-- (0.03 secs, 176,360 bytes)

Pensamiento

La inseguridad, la incertidumbre, la desconfianza, son acaso nuestras únicas verdades. Hay que aferrarse a ellas.

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

Menor contenedor de primos

PorJosé A. Alonso 10-diciembre-201817-enero-2019

El n-ésimo menor contenenedor de primos es el menor número que contiene como subcadenas los primeros n primos. Por ejemplo, el 6º menor contenedor de primos es 113257 ya que es el menor que contiene como subcadenas los 6 primeros primos (2, 3, 5, 7, 11 y 13).

Definir la función

   menorContenedor :: Int -> Int

1	menorContenedor :: Int -> Int

tal que (menorContenedor n) es el n-ésimo menor contenenedor de primos. Por ejemplo,

   menorContenedor 1  ==  2
   menorContenedor 2  ==  23
   menorContenedor 3  ==  235
   menorContenedor 4  ==  2357
   menorContenedor 5  ==  112357
   menorContenedor 6  ==  113257

menorContenedor 1 == 2

menorContenedor 2 == 23

menorContenedor 3 == 235

menorContenedor 4 == 2357

menorContenedor 5 == 112357

menorContenedor 6 == 113257

Soluciones

import Data.List           (isInfixOf)
import Data.Numbers.Primes (primes)

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

menorContenedor :: Int -> Int
menorContenedor n =
  head [x | x <- [2..]
          , and [contenido y x | y <- take n primes]]

contenido :: Int -> Int -> Bool
contenido x y =
  show x `isInfixOf` show y

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

menorContenedor2 :: Int -> Int
menorContenedor2 n =
  head [x | x <- [2..]
          , all (`contenido` x) (take n primes)]

import Data.List (isInfixOf)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

menorContenedor :: Int -> Int

menorContenedor n =

head [x | x <- [2..]

, and [contenido y x | y <- take n primes]]

contenido :: Int -> Int -> Bool

contenido x y =

show x `isInfixOf` show y

-- 2ª solución

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

menorContenedor2 :: Int -> Int

menorContenedor2 n =

head [x | x <- [2..]

, all (`contenido` x) (take n primes)]

Pensamiento

¡Ya hay hombres activos!
Soñaba la charca
con sus mosquitos.

Antonio Machado

Raíz cúbica entera

PorJosé A. Alonso 30-noviembre-201826-marzo-2022

Un número x es un cubo si existe un y tal que x = y^3. Por ejemplo, 8 es un cubo porque 8 = 2^3.

Definir la función

   raizCubicaEntera :: Integer -> Maybe Integer.

1	raizCubicaEntera :: Integer -> Maybe Integer.

tal que (raizCubicaEntera x n) es justo la raíz cúbica del número natural x, si x es un cubo y Nothing en caso contrario. Por ejemplo,

   raizCubicaEntera 8             ==  Just 2
   raizCubicaEntera 9             ==  Nothing
   raizCubicaEntera 27            ==  Just 3
   raizCubicaEntera 64            ==  Just 4
   raizCubicaEntera (2^30)        ==  Just 1024
   raizCubicaEntera (10^9000)     ==  Just (10^3000)
   raizCubicaEntera (5 + 10^9000) ==  Nothing

raizCubicaEntera 8 == Just 2

raizCubicaEntera 9 == Nothing

raizCubicaEntera 27 == Just 3

raizCubicaEntera 64 == Just 4

raizCubicaEntera (2^30) == Just 1024

raizCubicaEntera (10^9000) == Just (10^3000)

raizCubicaEntera (5 + 10^9000) == Nothing

Soluciones

import Test.QuickCheck

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

raizCubicaEntera :: Integer -> Maybe Integer
raizCubicaEntera x = aux 0
  where aux y | y^3 > x   = Nothing
              | y^3 == x  = Just y
              | otherwise = aux (y+1)

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

raizCubicaEntera2 :: Integer -> Maybe Integer
raizCubicaEntera2 x 
  | y^3 == x  = Just y
  | otherwise = Nothing
  where (y:_) = dropWhile (\y -> y^3 < x) [0..]

-- 3ª definición
-- =============

raizCubicaEntera3 :: Integer -> Maybe Integer 
raizCubicaEntera3 1 = Just 1
raizCubicaEntera3 x = aux (0,x)
    where aux (a,b) | d == x    = Just c
                    | c == a    = Nothing
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^3

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

raizCubicaEntera4 :: Integer -> Maybe Integer
raizCubicaEntera4 x 
  | y^3 == x  = Just y
  | otherwise = Nothing
  where y = floor ((fromIntegral x)**(1 / 3))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,
--    λ> raizCubicaEntera4 (2^30)
--    Nothing
--    λ> raizCubicaEntera (2^30)
--    Just 1024

-- Equivalencia
-- ============

-- La propiedad es                        
prop_raizCubicaEntera :: Integer -> Property
prop_raizCubicaEntera x =
  x >= 0 ==>
  and [raizCubicaEntera x == f x | f <- [ raizCubicaEntera2
                                        , raizCubicaEntera3]]

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

-- Comparación de eficiencia
-- =========================
  
--    λ> raizCubicaEntera (10^18)
--    Just 1000000
--    (1.80 secs, 1,496,137,192 bytes)
--    λ> raizCubicaEntera2 (10^18)
--    Just 1000000
--    (0.71 secs, 712,134,128 bytes)
--    λ> raizCubicaEntera3 (10^18)
--    Just 1000000
--    (0.01 secs, 196,424 bytes)
--
--    λ> raizCubicaEntera2 (5^27)
--    Just 1953125
--    (1.42 secs, 1,390,760,920 bytes)
--    λ> raizCubicaEntera3 (5^27)
--    Just 1953125
--    (0.00 secs, 195,888 bytes)
--
--    λ> raizCubicaEntera3 (10^9000) == Just (10^3000)
--    True
--    (2.05 secs, 420,941,368 bytes)
--    λ> raizCubicaEntera3 (5 + 10^9000) == Nothing
--    True
--    (2.08 secs, 420,957,576 bytes)

import Test.QuickCheck

-- 1ª definición

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

raizCubicaEntera :: Integer -> Maybe Integer

raizCubicaEntera x = aux 0

where aux y | y^3 > x = Nothing

| y^3 == x = Just y

| otherwise = aux (y+1)

-- 2ª definición

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

raizCubicaEntera2 :: Integer -> Maybe Integer

raizCubicaEntera2 x

| y^3 == x = Just y

| otherwise = Nothing

where (y:_) = dropWhile (\y -> y^3 < x) [0..]

-- 3ª definición

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

raizCubicaEntera3 :: Integer -> Maybe Integer

raizCubicaEntera3 1 = Just 1

raizCubicaEntera3 x = aux (0,x)

where aux (a,b) | d == x = Just c

| c == a = Nothing

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^3

-- 4ª definición

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

raizCubicaEntera4 :: Integer -> Maybe Integer

raizCubicaEntera4 x

| y^3 == x = Just y

| otherwise = Nothing

where y = floor ((fromIntegral x)**(1 / 3))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,

-- λ> raizCubicaEntera4 (2^30)

-- Nothing

-- λ> raizCubicaEntera (2^30)

-- Just 1024

-- Equivalencia

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

-- La propiedad es

prop_raizCubicaEntera :: Integer -> Property

prop_raizCubicaEntera x =

x >= 0 ==>

and [raizCubicaEntera x == f x | f <- [ raizCubicaEntera2

, raizCubicaEntera3]]

-- La comprobación es

-- λ> quickCheck prop_raizCubicaEntera

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> raizCubicaEntera (10^18)

-- Just 1000000

-- (1.80 secs, 1,496,137,192 bytes)

-- λ> raizCubicaEntera2 (10^18)

-- Just 1000000

-- (0.71 secs, 712,134,128 bytes)

-- λ> raizCubicaEntera3 (10^18)

-- Just 1000000

-- (0.01 secs, 196,424 bytes)

-- λ> raizCubicaEntera2 (5^27)

-- Just 1953125

-- (1.42 secs, 1,390,760,920 bytes)

-- λ> raizCubicaEntera3 (5^27)

-- Just 1953125

-- (0.00 secs, 195,888 bytes)

-- λ> raizCubicaEntera3 (10^9000) == Just (10^3000)

-- True

-- (2.05 secs, 420,941,368 bytes)

-- λ> raizCubicaEntera3 (5 + 10^9000) == Nothing

-- True

-- (2.08 secs, 420,957,576 bytes)

Pensamiento

Tras el vivir y el soñar,
está lo que más importa:
despertar.

Antonio Machado

Sucesión fractal

PorJosé A. Alonso 12-junio-201825-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

[schedule expon=’2018-06-19′ expat=»06:00″]

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

[/schedule]

[schedule on=’2018-06-19′ at=»06:00″]

-- 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](http://bit.ly/1WX1IjB) por Lionel Levine.
[/schedule]

Puntos alcanzables en un mapa

PorJosé A. Alonso 8-junio-20187-julio-2018

Un mapa con dos tipos de regiones (por ejemplo, tierra y mar) se puede representar mediante una matriz de ceros y unos.

Para los ejemplos usaremos los mapas definidos por

   type Punto = (Int,Int) 
   type Mapa  = Array Punto Int
   
   mapa1, mapa2 :: Mapa
   mapa1 = listArray ((1,1),(3,4))
                     [1,1,0,0,
                      0,1,0,0,
                      1,0,0,0]
   mapa2 = listArray ((1,1),(10,20))
                     [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                      1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
                      0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

type Punto = (Int,Int)

type Mapa = Array Punto Int

mapa1, mapa2 :: Mapa

mapa1 = listArray ((1,1),(3,4))

[1,1,0,0,

0,1,0,0,

1,0,0,0]

mapa2 = listArray ((1,1),(10,20))

[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,

0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

Definir las funciones

   alcanzables :: Mapa -> Punto -> [Punto]
   esAlcanzable :: Mapa -> Punto -> Punto -> Bool

1 2	alcanzables :: Mapa -> Punto -> [Punto] esAlcanzable :: Mapa -> Punto -> Punto -> Bool

tales que

(alcanzables p) es la lista de los puntos de mapa m que se pueden alcanzar a partir del punto p moviéndose en la misma región que p (es decir, a través de ceros si el elemento de m en p es un cero o a través de unos, en caso contrario) y los movimientos permitidos son ir hacia el norte, sur este u oeste (pero no en diagonal). Por ejemplo,

     alcanzables mapa1 (1,1)  ==  [(2,2),(1,2),(1,1)]
     alcanzables mapa1 (1,2)  ==  [(2,2),(1,1),(1,2)]
     alcanzables mapa1 (1,3)  ==  [(3,2),(3,4),(3,3),(2,3),(2,4),(1,4),(1,3)]
     alcanzables mapa1 (3,1)  ==  [(3,1)]

alcanzables mapa1 (1,1) == [(2,2),(1,2),(1,1)]

alcanzables mapa1 (1,2) == [(2,2),(1,1),(1,2)]

alcanzables mapa1 (1,3) == [(3,2),(3,4),(3,3),(2,3),(2,4),(1,4),(1,3)]

alcanzables mapa1 (3,1) == [(3,1)]

(esAlcanzable m p1 p2) se verifica si el punto p1 es alcanzable desde el p1 en el mapa m. Por ejemplo,

     esAlcanzable mapa1 (1,4) (3,2)    ==  True
     esAlcanzable mapa1 (1,4) (3,1)    ==  False
     esAlcanzable mapa2 (2,3) (8,16)   ==  True
     esAlcanzable mapa2 (8,1) (7,3)    ==  True
     esAlcanzable mapa2 (1,1) (10,20)  ==  False

esAlcanzable mapa1 (1,4) (3,2) == True

esAlcanzable mapa1 (1,4) (3,1) == False

esAlcanzable mapa2 (2,3) (8,16) == True

esAlcanzable mapa2 (8,1) (7,3) == True

esAlcanzable mapa2 (1,1) (10,20) == False

Nota: Este ejercicio está basado en el problema 10 kinds of people de Kattis.

Soluciones

import Data.Array

type Punto = (Int,Int) 
type Mapa  = Array Punto Int

mapa1, mapa2 :: Mapa
mapa1 = listArray ((1,1),(3,4))
                  [1,1,0,0,
                   0,1,0,0,
                   1,0,0,0]
mapa2 = listArray ((1,1),(10,20))
                  [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                   1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
                   0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

alcanzables :: Mapa -> Punto -> [Punto]
alcanzables mapa p = aux [p] []
  where region = mapa ! p
        (_,(m,n)) = bounds mapa
        vecinos (i,j) = [(a,b) | (a,b) <- [(i,j+1),(i,j-1),(i+1,j),(i-1,j)]
                               , 1 <= a && a <= m
                               , 1 <= b && b <= n  
                               , mapa ! (a,b) == region]
        aux [] ys = ys
        aux (x:xs) ys
          | x `elem` ys = aux xs ys
          | otherwise   = aux (vecinos x ++ xs) (x:ys)    

esAlcanzable :: Mapa -> Punto -> Punto -> Bool
esAlcanzable m p1 p2 =
  p2 `elem` alcanzables m p1

import Data.Array

type Punto = (Int,Int)

type Mapa = Array Punto Int

mapa1, mapa2 :: Mapa

mapa1 = listArray ((1,1),(3,4))

[1,1,0,0,

0,1,0,0,

1,0,0,0]

mapa2 = listArray ((1,1),(10,20))

[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,

0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

alcanzables :: Mapa -> Punto -> [Punto]

alcanzables mapa p = aux [p] []

where region = mapa ! p

(_,(m,n)) = bounds mapa

vecinos (i,j) = [(a,b) | (a,b) <- [(i,j+1),(i,j-1),(i+1,j),(i-1,j)]

, 1 <= a && a <= m

, 1 <= b && b <= n

, mapa ! (a,b) == region]

aux [] ys = ys

aux (x:xs) ys

| x `elem` ys = aux xs ys

| otherwise = aux (vecinos x ++ xs) (x:ys)

esAlcanzable :: Mapa -> Punto -> Punto -> Bool

esAlcanzable m p1 p2 =

p2 `elem` alcanzables m p1

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]

Números de Church

PorJosé A. Alonso 28-mayo-20185-junio-2018

Los números naturales pueden definirse de forma alternativa empleando los números de Church. Podemos representar un número natural n como una función que toma una función f como parámetro y devuelve n veces f.

Definimos por tanto los números naturales como

   Type Nat = forall a. (a -> a) -> a -> a

1	Type Nat = forall a. (a -> a) -> a -> a

De esta forma, para representar el número uno, repetir una vez una función es lo mismo que solamente aplicarla.

   uno :: Nat
   uno f x = f x

1 2	uno :: Nat uno f x = f x

De manera similar, dos debe aplicar f dos veces a su argumento.

   dos :: Nat
   dos f x = f (f x)

1 2	dos :: Nat dos f x = f (f x)

Definir cero equivale por tanto a devolver el argumento sin modificar.

   cero :: Nat
   cero f x = x

1 2	cero :: Nat cero f x = x

Definir las funciones

   cero    :: Nat
   uno     :: Nat
   dos     :: Nat
   tres    :: Nat
   nat2Int :: Nat -> Int
   succ    :: Nat -> Nat
   suma    :: Nat -> Nat -> Nat
   mult    :: Nat -> Nat -> Nat
   exp     :: Nat -> Nat -> Nat

cero :: Nat

uno :: Nat

dos :: Nat

tres :: Nat

nat2Int :: Nat -> Int

succ :: Nat -> Nat

suma :: Nat -> Nat -> Nat

mult :: Nat -> Nat -> Nat

exp :: Nat -> Nat -> Nat

tales que

cero, uno y dos son definiciones alternativas a las ya dadas y tres es el número natural 3 con esta representación.
(nat2Int n) es el número entero correspondiente al número natuaral n. Por ejemplo,

    nat2Int cero == 0
    nat2Int uno  == 1
    nat2Int dos  == 2
    nat2Int tres == 3

nat2Int cero == 0

nat2Int uno == 1

nat2Int dos == 2

nat2Int tres == 3

(succ n) es el sucesor del número n. Por ejemplo,

     nat2Int (succ dos)   ==  3
     nat2Int (succ tres)  ==  4

1 2	nat2Int (succ dos) == 3 nat2Int (succ tres) == 4

(suma n m) es la suma de n y m. Por ejemplo,

     nat2Int (suma dos tres)         ==  5
     nat2Int (suma dos (succ tres))  ==  6

1 2	nat2Int (suma dos tres) == 5 nat2Int (suma dos (succ tres)) == 6

(mult n m) es el producto de n y m. Por ejemplo,

     nat2Int (mult dos tres)         ==  6
     nat2Int (mult dos (succ tres))  ==  8

1 2	nat2Int (mult dos tres) == 6 nat2Int (mult dos (succ tres)) == 8

(exp n m) es la potencia m-ésima de n. Por ejemplo,

     nat2Int (exp dos tres)   ==  8
     nat2Int (exp tres dos)   ==  9
     nat2Int (exp tres cero)  ==  1
     nat2Int (exp cero tres)  ==  0

nat2Int (exp dos tres) == 8

nat2Int (exp tres dos) == 9

nat2Int (exp tres cero) == 1

nat2Int (exp cero tres) == 0

Comprobar con QuickCheck las siguientes propiedades. Para ello importar la librería Test.QuickCheck.Function y seguir el siguiente ejemplo:

   prop_Succ1 :: Fun Int Int -> Int -> Bool
   prop_Succ1 (Fun _ f) x = succ cero f x == uno f x

   succ uno                   = dos
   succ dos                   = tres
   suma cero uno              = uno
   suma dos tres              = suma tres dos
   suma (suma dos dos) tres   = suma uno (suma tres tres)
   mult uno uno               = uno
   mult cero (suma tres tres) = cero
   mult dos tres              = suma tres tres
   exp dos dos                = suma dos dos
   exp tres dos               = suma (mult dos (mult dos dos)) uno
   exp tres cero              = uno

prop_Succ1 :: Fun Int Int -> Int -> Bool

prop_Succ1 (Fun _ f) x = succ cero f x == uno f x

succ uno = dos

succ dos = tres

suma cero uno = uno

suma dos tres = suma tres dos

suma (suma dos dos) tres = suma uno (suma tres tres)

mult uno uno = uno

mult cero (suma tres tres) = cero

mult dos tres = suma tres tres

exp dos dos = suma dos dos

exp tres dos = suma (mult dos (mult dos dos)) uno

exp tres cero = uno

Nota 1: Añadir al inicio del archivo del ejercicio los pragmas

   {-# LANGUAGE RankNTypes #-}
   {-# LANGUAGE TemplateHaskell #-}

1 2	{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}

Nota 2: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

import Prelude hiding (succ, exp)
import Test.QuickCheck
import Test.QuickCheck.Function

type Nat = forall a. (a -> a) -> a -> a

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

cero1 :: Nat
cero1 f x = x

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

cero2 :: Nat
cero2 = (\ _ x -> x)

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

cero3 :: Nat
cero3 _ x = x

-- 4ª definición de cero
-- =====================

cero4 :: Nat
cero4 _ = id

-- 5ª definición de cero
-- =====================

cero5 :: Nat
cero5 = seq

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

uno1 :: Nat
uno1 f x = f x

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

uno2 :: Nat
uno2 = (\ f x -> f x)

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

uno3 :: Nat
uno3 = ($)

-- 4ª definición de uno
-- ====================

uno4 :: Nat
uno4 = id

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

dos1 :: Nat
dos1 f x = f (f x)

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

dos2 :: Nat
dos2 f = f . f

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

tres1 :: Nat
tres1 f x = f (dos f x)

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

tres2 :: Nat
tres2 f = f . (dos f)

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

tres3 :: Nat
tres3 f = f . f . f

-- Definición de nat2Int
-- =====================

nat2Int :: Nat -> Int
nat2Int x = x (+1) 0

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

succ1 :: Nat -> Nat
succ1 n f x = f (n f x)

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

succ2 :: Nat -> Nat
succ2 n f = f . n f

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

suma1 :: Nat -> Nat -> Nat
suma1 n m f x = n f (m f x)

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

suma2 :: Nat -> Nat -> Nat
suma2 n m f = n f . m f

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

mult1 :: Nat -> Nat -> Nat
mult1 n m f x = n (m f) x

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

mult2 :: Nat -> Nat -> Nat
mult2 n m f = n (m f)

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

mult3 :: Nat -> Nat -> Nat
mult3 n m = n . m

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

exp1 :: Nat -> Nat -> Nat
exp1 n m f x = m (\y -> (\z -> (n y z))) f x

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

exp2 :: Nat -> Nat -> Nat
exp2 n m f = m n f

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

exp3 :: Nat -> Nat -> Nat
exp3 n m = m n

-- Comprobaciones
-- ==============

-- Para las comprobaciones emplearemos las siguientes funciones:

cero, uno, dos, tres :: Nat
cero = cero5
uno  = uno4
dos  = dos2
tres = tres3
succ = succ2

suma, mult, exp :: Nat -> Nat -> Nat
suma = suma2
mult = mult3
exp  = exp3

prop_Succ1, prop_Succ2, prop_Succ3 :: Fun Int Int -> Int -> Bool
prop_Succ1 (Fun _ f) x =
  succ cero f x == uno  f x
prop_Succ2 (Fun _ f) x =
  succ uno  f x == dos  f x
prop_Succ3 (Fun _ f) x =
  succ dos  f x == tres f x

prop_Suma1, prop_Suma2, prop_Suma3 :: Fun Int Int -> Int -> Bool
prop_Suma1 (Fun _ f) x =
  suma cero uno f x == uno f x
prop_Suma2 (Fun _ f) x =
  suma dos tres f x == suma tres dos f x
prop_Suma3 (Fun _ f) x =
  suma (suma dos dos) tres f x == suma uno (suma tres tres) f x

prop_Mult1, prop_Mult2, prop_Mult3 :: Fun Int Int -> Int -> Bool
prop_Mult1 (Fun _ f) x =
  mult uno uno f x == uno f x
prop_Mult2 (Fun _ f) x =
  mult cero (suma tres tres) f x == cero f x
prop_Mult3 (Fun _ f) x =
  mult dos tres f x == suma tres tres f x

prop_Exp1, prop_Exp2, prop_Exp3 :: Fun Int Int -> Int -> Bool
prop_Exp1 (Fun _ f) x =
  exp dos dos f x == suma dos dos f x
prop_Exp2 (Fun _ f) x =
  exp tres dos f x == suma (mult dos (mult dos dos)) uno f x
prop_Exp3 (Fun _ f) x =
  exp tres cero f x == uno f x
  
return []
runTests = $quickCheckAll

-- La comprobación es
--    λ> runTests
--    === prop_Succ1 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Suma1 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Mult1 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Exp1 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Succ2 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Succ3 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Suma2 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Suma3 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Mult2 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Mult3 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Exp2 ===
--    +++ OK, passed 100 tests.
--    
--    === prop_Exp3 ===
--    +++ OK, passed 100 tests.
--    
--    True

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

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

{-# LANGUAGE RankNTypes #-}

{-# LANGUAGE TemplateHaskell #-}

import Prelude hiding (succ, exp)

import Test.QuickCheck

import Test.QuickCheck.Function

type Nat = forall a. (a -> a) -> a -> a

-- 1ª definición de cero

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

cero1 :: Nat

cero1 f x = x

-- 2ª definición de cero

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

cero2 :: Nat

cero2 = (\ _ x -> x)

-- 3ª definición de cero

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

cero3 :: Nat

cero3 _ x = x

-- 4ª definición de cero

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

cero4 :: Nat

cero4 _ = id

-- 5ª definición de cero

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

cero5 :: Nat

cero5 = seq

-- 1ª definición de uno

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

uno1 :: Nat

uno1 f x = f x

-- 2ª definición de uno

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

uno2 :: Nat

uno2 = (\ f x -> f x)

-- 3ª definición de uno

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

uno3 :: Nat

uno3 = ($)

-- 4ª definición de uno

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

uno4 :: Nat

uno4 = id

-- 1ª definición de dos

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

dos1 :: Nat

dos1 f x = f (f x)

-- 2ª definición de dos

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

dos2 :: Nat

dos2 f = f . f

-- 1ª definición de tres

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

tres1 :: Nat

tres1 f x = f (dos f x)

-- 2ª definición de tres

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

tres2 :: Nat

tres2 f = f . (dos f)

-- 3ª definición de tres

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

tres3 :: Nat

tres3 f = f . f . f

-- Definición de nat2Int

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

nat2Int :: Nat -> Int

nat2Int x = x (+1) 0

-- 1ª definición de succ

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

succ1 :: Nat -> Nat

succ1 n f x = f (n f x)

-- 2ª definición de succ

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

succ2 :: Nat -> Nat

succ2 n f = f . n f

-- 1ª definición de suma

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

suma1 :: Nat -> Nat -> Nat

suma1 n m f x = n f (m f x)

-- 2ª definición de suma

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

suma2 :: Nat -> Nat -> Nat

suma2 n m f = n f . m f

-- 1ª definición de mult

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

mult1 :: Nat -> Nat -> Nat

mult1 n m f x = n (m f) x

-- 2ª definición de mult

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

mult2 :: Nat -> Nat -> Nat

mult2 n m f = n (m f)

-- 3ª definición de mult

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

mult3 :: Nat -> Nat -> Nat

mult3 n m = n . m

-- 1ª definición de exp

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

exp1 :: Nat -> Nat -> Nat

exp1 n m f x = m (\y -> (\z -> (n y z))) f x

-- 2ª definición de exp

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

exp2 :: Nat -> Nat -> Nat

exp2 n m f = m n f

-- 3ª definición de exp

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

exp3 :: Nat -> Nat -> Nat

exp3 n m = m n

-- Comprobaciones

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

-- Para las comprobaciones emplearemos las siguientes funciones:

cero, uno, dos, tres :: Nat

cero = cero5

uno = uno4

dos = dos2

tres = tres3

succ = succ2

suma, mult, exp :: Nat -> Nat -> Nat

suma = suma2

mult = mult3

exp = exp3

prop_Succ1, prop_Succ2, prop_Succ3 :: Fun Int Int -> Int -> Bool

prop_Succ1 (Fun _ f) x =

succ cero f x == uno f x

prop_Succ2 (Fun _ f) x =

succ uno f x == dos f x

prop_Succ3 (Fun _ f) x =

succ dos f x == tres f x

prop_Suma1, prop_Suma2, prop_Suma3 :: Fun Int Int -> Int -> Bool

prop_Suma1 (Fun _ f) x =

suma cero uno f x == uno f x

prop_Suma2 (Fun _ f) x =

suma dos tres f x == suma tres dos f x

prop_Suma3 (Fun _ f) x =

suma (suma dos dos) tres f x == suma uno (suma tres tres) f x

prop_Mult1, prop_Mult2, prop_Mult3 :: Fun Int Int -> Int -> Bool

prop_Mult1 (Fun _ f) x =

mult uno uno f x == uno f x

prop_Mult2 (Fun _ f) x =

mult cero (suma tres tres) f x == cero f x

prop_Mult3 (Fun _ f) x =

mult dos tres f x == suma tres tres f x

prop_Exp1, prop_Exp2, prop_Exp3 :: Fun Int Int -> Int -> Bool

prop_Exp1 (Fun _ f) x =

exp dos dos f x == suma dos dos f x

prop_Exp2 (Fun _ f) x =

exp tres dos f x == suma (mult dos (mult dos dos)) uno f x

prop_Exp3 (Fun _ f) x =

exp tres cero f x == uno f x

return []

runTests = $quickCheckAll

-- La comprobación es

-- λ> runTests

-- === prop_Succ1 ===

-- +++ OK, passed 100 tests.

-- === prop_Suma1 ===

-- +++ OK, passed 100 tests.

-- === prop_Mult1 ===

-- +++ OK, passed 100 tests.

-- === prop_Exp1 ===

-- +++ OK, passed 100 tests.

-- === prop_Succ2 ===

-- +++ OK, passed 100 tests.

-- === prop_Succ3 ===

-- +++ OK, passed 100 tests.

-- === prop_Suma2 ===

-- +++ OK, passed 100 tests.

-- === prop_Suma3 ===

-- +++ OK, passed 100 tests.

-- === prop_Mult2 ===

-- +++ OK, passed 100 tests.

-- === prop_Mult3 ===

-- +++ OK, passed 100 tests.

-- === prop_Exp2 ===

-- +++ OK, passed 100 tests.

-- === prop_Exp3 ===

-- +++ OK, passed 100 tests.

-- True

Caminos reducidos

PorJosé A. Alonso 25-mayo-201825-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)

Problema de las 3 jarras

PorJosé A. Alonso 23-mayo-201830-mayo-2018

En el problema de las tres jarras (A,B,C) se dispone de tres jarras de capacidades A, B y C litros con A > B > C y A par. Inicialmente la jarra mayor está llena y las otras dos vacías. Queremos, trasvasando adecuadamente el líquido entre las jarras, repartir por igual el contenido inicial entre las dos jarras mayores. Por ejemplo, para el problema (8,5,3) el contenido inicial es (8,0,0) y el final es (4,4,0).

Definir las funciones

   solucionesTresJarras :: Problema -> [[Estado]]
   tresJarras :: Problema -> Maybe [Estado]

1 2	solucionesTresJarras :: Problema -> [[Estado]] tresJarras :: Problema -> Maybe [Estado]

tales que

(solucionesTresJarras p) es la lista de soluciones del problema de las tres jarras p. Por ejemplo,

     λ> mapM_ print (solucionesTresJarras (4,2,1))
     [(4,0,0),(2,2,0)]
     [(4,0,0),(3,0,1),(1,2,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]
     λ> mapM_ print (solucionesTresJarras (8,6,2))
     [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     λ> length (solucionesTresJarras (8,5,3))
     16
     λ> head (solucionesTresJarras (8,5,3))
     [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> length (solucionesTresJarras (8,6,5))
     0

λ> mapM_ print (solucionesTresJarras (4,2,1))

[(4,0,0),(2,2,0)]

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

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

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

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

λ> mapM_ print (solucionesTresJarras (8,6,2))

[(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

λ> length (solucionesTresJarras (8,5,3))

λ> head (solucionesTresJarras (8,5,3))

[(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> length (solucionesTresJarras (8,6,5))

(tresJarras p) es una solución del problema de las tres jarras p con el mínimo mínimo número de trasvase, si p tiene solución y Nothing, en caso contrario. Por ejemplo,

     λ> tresJarras (4,2,1)
     Just [(4,0,0),(2,2,0)]
     λ> tresJarras (8,6,2)
     Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     λ> tresJarras (8,5,3)
     Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> tresJarras (8,6,5)
     Nothing

λ> tresJarras (4,2,1)

Just [(4,0,0),(2,2,0)]

λ> tresJarras (8,6,2)

Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

λ> tresJarras (8,5,3)

Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> tresJarras (8,6,5)

Nothing

Soluciones

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero el de la
-- tercera.
type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la
-- jarra de A litros, el segundo el de la de B litros y el tercero el de
-- la de C litros.
type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]
solucionesTresJarras p = busca [[inicial p]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = reverse (e:es) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo, 
--    inicial (8,5,3)  ==  (8,0,0)
inicial :: Problema -> Estado
inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- tres jarras p. Por ejemplo,
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (a,_,_) (x,y,z) =
  x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el
-- problema de las tres jarras p. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,c) (x,y,z) =
     [(x-ab,y+ab,z)    | let ab = min x (b-y), ab > 0]
  ++ [(x-ac,y   ,z+ac) | let ac = min x (c-z), ac > 0]
  ++ [(x+ba,y-ba,z)    | let ba = min y (a-x), ba > 0]
  ++ [(x   ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]
  ++ [(x+ca,y   ,z-ca) | let ca = min z (a-x), ca > 0]
  ++ [(x   ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]
  
tresJarras :: Problema -> Maybe [Estado]
tresJarras p = listToMaybe (solucionesTresJarras p)

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero el de la

-- tercera.

type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la

-- jarra de A litros, el segundo el de la de B litros y el tercero el de

-- la de C litros.

type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]

solucionesTresJarras p = busca [[inicial p]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = reverse (e:es) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,

-- inicial (8,5,3) == (8,0,0)

inicial :: Problema -> Estado

inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- tres jarras p. Por ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal :: Problema -> Estado -> Bool

esFinal (a,_,_) (x,y,z) =

x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el

-- problema de las tres jarras p. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,c) (x,y,z) =

[(x-ab,y+ab,z) | let ab = min x (b-y), ab > 0]

++ [(x-ac,y ,z+ac) | let ac = min x (c-z), ac > 0]

++ [(x+ba,y-ba,z) | let ba = min y (a-x), ba > 0]

++ [(x ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]

++ [(x+ca,y ,z-ca) | let ca = min z (a-x), ca > 0]

++ [(x ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]

tresJarras :: Problema -> Maybe [Estado]

tresJarras p = listToMaybe (solucionesTresJarras p)

Sucesión de Recamán

PorJosé A. Alonso 11-mayo-201826-marzo-2022

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

a(0) = 0

a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión

a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,

      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163

λ> take 25 sucRecaman3

[0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

(invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,

      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

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

sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]

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

sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n

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

sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 

-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)

-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

import qualified Data.Set as S

-- 1ª solución

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

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

suc1 n | y > n && y - n `notElem` ys = y - n

| otherwise = y + n

where y = suc1 (n - 1)

ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución

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

sucRecaman2 :: [Int]

sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)

where f y n ys | y > n && y - n `notElem` take n ys = y - n

| otherwise = y + n

-- 3ª solución

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

sucRecaman3 :: [Int]

sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]

recaman s n x

| x > n && (x-n) `S.notMember` s =

(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)

| otherwise =

(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

-- (3.76 secs, 2,394,593,952 bytes)

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

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

-- 14358

-- (2.69 secs, 6,927,559,784 bytes)

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

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

[invRecaman k | k <- [0..n]]

Problema de las jarras

PorJosé A. Alonso 10-mayo-201817-mayo-2018

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en alguna de las dos jarras.

Definir la función

   jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]

1	jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]

tal (jarras (a,b,c)) es una solución del problema de las jarras (a,b,c) con el mínimo número de movimientos, si el problema tiene solución y Nothing, en caso contrario. Por ejemplo,

   λ> jarras (5,3,4)
   Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

1 2	λ> jarras (5,3,4) Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

La interpretación de la solución anterior es

   (0,0) se inicia con las dos jarras vacías,
   (5,0) se llena la jarra de 5 con el grifo,
   (2,3) se llena la de 3 con la de 5,
   (2,0) se vacía la de 3,
   (0,2) se pasa el contenido de la primera a la segunda,
   (5,2) se llena la primera con el grifo,
   (4,3) se llena la segunda con la primera.

(0,0) se inicia con las dos jarras vacías,

(5,0) se llena la jarra de 5 con el grifo,

(2,3) se llena la de 3 con la de 5,

(2,0) se vacía la de 3,

(0,2) se pasa el contenido de la primera a la segunda,

(5,2) se llena la primera con el grifo,

(4,3) se llena la segunda con la primera.

Otros ejemplos:

   λ> jarras (3,5,4)
   Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]
   λ> jarras (15,10,5)
   Just [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   Nothing
   λ> length <$> jarras (181,179,100)
   Just 199

λ> jarras (3,5,4)

Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]

λ> jarras (15,10,5)

Just [(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

Nothing

λ> length <$> jarras (181,179,100)

Just 199

Soluciones

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero es el número
-- de litros que hay que obtener.
type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la
-- jarra de A litros y el segundo el de la de B litros.  
type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]
jarras p | null ns   = Nothing
         | otherwise = Just (head ns)
  where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo, 
--    λ> take 2 (soluciones (15,10,5))
--    [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]
--    λ> length (soluciones (15,10,5))
--    6
--    λ> soluciones (15,10,4)
--    []
soluciones :: Problema -> [[Estado]]
soluciones p = busca [[inicial]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = (reverse (e:es)) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- inicial es el estado inicial
inicial :: Estado
inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- jarras p. Por ejemplo,
--    esFinal (5,4,3) (3,2)  ==  True
--    esFinal (5,4,3) (2,3)  ==  True
--    esFinal (5,4,1) (2,3)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por
-- ejemplo, 
--    λ> sucesores (7,4,3) (1,2)
--    [(7,2),(1,4),(0,2),(1,0),(3,0),(0,3)]
--    λ> sucesores (7,4,3) (6,3)
--    [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > a - x] ++
    [(x-(b-y),b) | y < b, x > b - y] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe
jarras2 :: Problema -> Maybe [Estado]
jarras2 p = listToMaybe (soluciones p)

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero es el número

-- de litros que hay que obtener.

type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la

-- jarra de A litros y el segundo el de la de B litros.

type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]

jarras p | null ns = Nothing

| otherwise = Just (head ns)

where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo,

-- λ> take 2 (soluciones (15,10,5))

-- [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]

-- λ> length (soluciones (15,10,5))

-- 6

-- λ> soluciones (15,10,4)

-- []

soluciones :: Problema -> [[Estado]]

soluciones p = busca [[inicial]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = (reverse (e:es)) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- inicial es el estado inicial

inicial :: Estado

inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- jarras p. Por ejemplo,

-- esFinal (5,4,3) (3,2) == True

-- esFinal (5,4,3) (2,3) == True

-- esFinal (5,4,1) (2,3) == False

esFinal :: Problema -> Estado -> Bool

esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por

-- ejemplo,

-- λ> sucesores (7,4,3) (1,2)

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

-- λ> sucesores (7,4,3) (6,3)

-- [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > a - x] ++

[(x-(b-y),b) | y < b, x > b - y] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe

jarras2 :: Problema -> Maybe [Estado]

jarras2 p = listToMaybe (soluciones p)

Mayor número de atracciones visitables

PorJosé A. Alonso 9-mayo-201816-mayo-2018

En el siguiente gráfico se representa en una cuadrícula el plano de Manhattan. Cada línea es una opción a seguir; el número representa las atracciones que se pueden visitar si se elige esa opción.

         3         2         4         0
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |1        |0        |2        |4        |3
    |    3    |    2    |    4    |    2    |
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |4        |6        |5        |2        |1
    |    0    |    7    |    3    |    4    |
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |4        |4        |5        |2        |1
    |    3    |    3    |    0    |    2    |
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |5        |6        |8        |5        |3
    |    1    |    3    |    2    |    2    |
    * ------- * ------- * ------- * ------- *

3 2 4 0

* ------- * ------- * ------- * ------- *

| | | | |

|1 |0 |2 |4 |3

| 3 | 2 | 4 | 2 |

* ------- * ------- * ------- * ------- *

| | | | |

|4 |6 |5 |2 |1

| 0 | 7 | 3 | 4 |

* ------- * ------- * ------- * ------- *

| | | | |

|4 |4 |5 |2 |1

| 3 | 3 | 0 | 2 |

* ------- * ------- * ------- * ------- *

| | | | |

|5 |6 |8 |5 |3

| 1 | 3 | 2 | 2 |

* ------- * ------- * ------- * ------- *

El turista entra por el extremo superior izquierda y sale por el extremo inferior derecha. Sólo puede moverse en las direcciones Sur y Este (es decir, hacia abajo o hacia la derecha).

Representamos el mapa mediante una matriz p tal que p(i,j) = (a,b), donde a = nº de atracciones si se va hacia el sur y b = nº de atracciones si se va al este. Además, ponemos un 0 en el valor del número de atracciones por un camino que no se puede elegir. De esta forma, el mapa anterior se representa por la matriz siguiente:

   ( (1,3)   (0,2)   (2,4)   (4,0)  (3,0) )
   ( (4,3)   (6,2)   (5,4)   (2,2)  (1,0) )
   ( (4,0)   (4,7)   (5,3)   (2,4)  (1,0) )
   ( (5,3)   (6,3)   (8,0)   (5,2)  (3,0) )
   ( (0,1)   (0,3)   (0,2)   (0,2)  (0,0) )

( (1,3) (0,2) (2,4) (4,0) (3,0) )

( (4,3) (6,2) (5,4) (2,2) (1,0) )

( (4,0) (4,7) (5,3) (2,4) (1,0) )

( (5,3) (6,3) (8,0) (5,2) (3,0) )

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

En este caso, si se hace el recorrido

   [S, E, S, E, S, S, E, E],

1	[S, E, S, E, S, S, E, E],

el número de atracciones es

    1  3  6  7  5  8  2  2

1	1 3 6 7 5 8 2 2

cuya suma es 34.

Definir la función

   mayorNumeroV:: M.Matrix (Int,Int) -> Int

1	mayorNumeroV:: M.Matrix (Int,Int) -> Int

tal que (mayorNumeroV p) es el máximo número de atracciones que se pueden visitar en el plano representado por la matriz p. Por ejemplo, si se define la matriz anterior por

   ejMapa :: M.Matrix (Int,Int)
   ejMapa = M.fromLists [[(1,3),(0,2),(2,4),(4,0),(3,0)], 
                         [(4,3),(6,2),(5,4),(2,2),(1,0)],
                         [(4,0),(4,7),(5,3),(2,4),(1,0)],
                         [(5,3),(6,3),(8,0),(5,2),(3,0)],
                         [(0,1),(0,3),(0,2),(0,2),(0,0)]]

ejMapa :: M.Matrix (Int,Int)

ejMapa = M.fromLists [[(1,3),(0,2),(2,4),(4,0),(3,0)],

[(4,3),(6,2),(5,4),(2,2),(1,0)],

[(4,0),(4,7),(5,3),(2,4),(1,0)],

[(5,3),(6,3),(8,0),(5,2),(3,0)],

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

entonces

   mayorNumeroV ejMapa                                     ==  34
   mayorNumeroV (fromLists [[(1,3),(0,0)],[(0,3),(0,0)]])  ==  4
   mayorNumeroV (fromLists [[(1,3),(6,0)],[(0,3),(0,0)]])  ==  9

mayorNumeroV ejMapa == 34

mayorNumeroV (fromLists [[(1,3),(0,0)],[(0,3),(0,0)]]) == 4

mayorNumeroV (fromLists [[(1,3),(6,0)],[(0,3),(0,0)]]) == 9

Para los siguientes ejemplos se define un generador de mapas

   genMapa :: Int -> Matrix (Int,Int)
   genMapa n =
     extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

genMapa :: Int -> Matrix (Int,Int)

genMapa n =

extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

Entonces,

   mayorNumeroV (genMapa 10)  ==  962
   mayorNumeroV (genMapa 500)  ==  185880992

1 2	mayorNumeroV (genMapa 10) == 962 mayorNumeroV (genMapa 500) == 185880992

Soluciones

import Data.Matrix

ejMapa :: Matrix (Int,Int)
ejMapa = fromLists  [[(1,3),(0,2),(2,4),(4,0),(3,0)], 
                     [(4,3),(6,2),(5,4),(2,2),(1,0)],
                     [(4,0),(4,7),(5,3),(2,4),(1,0)],
                     [(5,3),(6,3),(8,0),(5,2),(3,0)],
                     [(0,1),(0,3),(0,2),(0,2),(0,0)]]

genMapa :: Int -> Matrix (Int,Int)
genMapa n =
  extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

-- 1ª definición (por recursión)
-- =============================

mayorNumeroV1 :: Matrix (Int,Int) -> Int
mayorNumeroV1 p = aux m n
  where m = nrows p
        n = ncols p
        aux 1 1 = 0
        aux 1 j = sum [snd (p !(1,k)) | k <- [1..j-1]]
        aux i 1 = sum [fst (p !(k,1)) | k <- [1..i-1]]
        aux i j = max ((aux (i-1) j) + fst (p !(i-1,j)))
                      ((aux i (j-1)) + snd (p !(i,j-1)))

-- 2ª solución (con programación dinámica)
-- =======================================

mayorNumeroV2 :: Matrix (Int,Int) -> Int
mayorNumeroV2 p = (matrizNumeroV p) ! (m,n)
  where m = nrows p
        n = ncols p

matrizNumeroV :: Matrix (Int,Int) -> Matrix Int
matrizNumeroV p = q
  where m = nrows p
        n = ncols p
        q = matrix m n f
        f (1,1) = 0
        f (1,j) = snd (p!(1,j-1)) + q!(1,j-1)
        f (i,1) = fst (p!(i-1,1)) + q!(i-1,1)
        f (i,j) = max (fst (p!(i-1,j)) + q!(i-1,j))
                      (snd (p!(i,j-1)) + q!(i,j-1))

-- 3ª solución (con programación dinámica)
-- =======================================

mayorNumeroV3 :: Matrix (Int, Int) -> Int
mayorNumeroV3 mapa = m ! (1,1)
  where m = matrix r c f
        r = nrows mapa
        c = ncols mapa
        f (i,j) | i == r && j == c = 0
                | i == r           = e + m !(r,j+1)
                | j == c           = s + m !(i+1,c)
                | otherwise        = max (e + m !(i, j+1)) (s + m !(i+1, j))
          where (s,e) = mapa ! (i,j)

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

--    λ> mayorNumeroV1 (genMapa 11)
--    1334
--    (2.07 secs, 352,208,752 bytes)
--    λ> mayorNumeroV2 (genMapa 11)
--    1334
--    (0.01 secs, 319,792 bytes)
--    λ> mayorNumeroV3 (genMapa 11)
--    1334
--    (0.01 secs, 299,936 bytes)
--    
--    λ> mayorNumeroV2 (genMapa 500)
--    185880992
--    (2.26 secs, 374,557,416 bytes)
--    λ> mayorNumeroV3 (genMapa 500)
--    185880992
--    (3.15 secs, 401,098,336 bytes)

import Data.Matrix

ejMapa :: Matrix (Int,Int)

ejMapa = fromLists [[(1,3),(0,2),(2,4),(4,0),(3,0)],

[(4,3),(6,2),(5,4),(2,2),(1,0)],

[(4,0),(4,7),(5,3),(2,4),(1,0)],

[(5,3),(6,3),(8,0),(5,2),(3,0)],

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

genMapa :: Int -> Matrix (Int,Int)

genMapa n =

extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

-- 1ª definición (por recursión)

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

mayorNumeroV1 :: Matrix (Int,Int) -> Int

mayorNumeroV1 p = aux m n

where m = nrows p

n = ncols p

aux 1 1 = 0

aux 1 j = sum [snd (p !(1,k)) | k <- [1..j-1]]

aux i 1 = sum [fst (p !(k,1)) | k <- [1..i-1]]

aux i j = max ((aux (i-1) j) + fst (p !(i-1,j)))

((aux i (j-1)) + snd (p !(i,j-1)))

-- 2ª solución (con programación dinámica)

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

mayorNumeroV2 :: Matrix (Int,Int) -> Int

mayorNumeroV2 p = (matrizNumeroV p) ! (m,n)

where m = nrows p

n = ncols p

matrizNumeroV :: Matrix (Int,Int) -> Matrix Int

matrizNumeroV p = q

where m = nrows p

n = ncols p

q = matrix m n f

f (1,1) = 0

f (1,j) = snd (p!(1,j-1)) + q!(1,j-1)

f (i,1) = fst (p!(i-1,1)) + q!(i-1,1)

f (i,j) = max (fst (p!(i-1,j)) + q!(i-1,j))

(snd (p!(i,j-1)) + q!(i,j-1))

-- 3ª solución (con programación dinámica)

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

mayorNumeroV3 :: Matrix (Int, Int) -> Int

mayorNumeroV3 mapa = m ! (1,1)

where m = matrix r c f

r = nrows mapa

c = ncols mapa

f (i,j) | i == r && j == c = 0

| i == r = e + m !(r,j+1)

| j == c = s + m !(i+1,c)

| otherwise = max (e + m !(i, j+1)) (s + m !(i+1, j))

where (s,e) = mapa ! (i,j)

-- Comparación de eficiencia

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

-- λ> mayorNumeroV1 (genMapa 11)

-- 1334

-- (2.07 secs, 352,208,752 bytes)

-- λ> mayorNumeroV2 (genMapa 11)

-- 1334

-- (0.01 secs, 319,792 bytes)

-- λ> mayorNumeroV3 (genMapa 11)

-- 1334

-- (0.01 secs, 299,936 bytes)

-- λ> mayorNumeroV2 (genMapa 500)

-- 185880992

-- (2.26 secs, 374,557,416 bytes)

-- λ> mayorNumeroV3 (genMapa 500)

-- 185880992

-- (3.15 secs, 401,098,336 bytes)

Operaciones con series de potencias

PorJosé A. Alonso 27-abril-201825-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 por un conjunto de primos

PorJosé A. Alonso 20-abril-201830-abril-2018

Los números compuestos por un conjunto de primos son los números cuyos factores primos pertenecen al conjunto. Por ejemplo, los primeros números compuestos por [2,5,7] son

   1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

1	1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

El 28 es compuesto ya que sus divisores primos son 2 y 7 que están en [2,5,7].

Definir la función

   compuestos :: [Integer] -> [Integer]

1	compuestos :: [Integer] -> [Integer]

tal que (compuesto ps) es la lista de los números compuestos por el conjunto de primos ps. Por ejemplo,

   λ> take 20 (compuestos [2,5,7])
   [1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]
   λ> take 20 (compuestos [2,5])
   [1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]
   λ> take 20 (compuestos [2,3,5])
   [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]
   λ> take 20 (compuestos [3,5,7,11,13])
   [1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]
   λ> take 15 (compuestos [2])
   [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]
   λ> compuestos [2,7] !! (10^4)
   57399514149595471961908157955229677377312712667508119466382354072731648
   λ> compuestos [2,3,5] !! (10^5)
   290237644800000000000000000000000000000

λ> take 20 (compuestos [2,5,7])

[1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]

λ> take 20 (compuestos [2,5])

[1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]

λ> take 20 (compuestos [2,3,5])

[1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]

λ> take 20 (compuestos [3,5,7,11,13])

[1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]

λ> take 15 (compuestos [2])

[1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]

λ> compuestos [2,7] !! (10^4)

57399514149595471961908157955229677377312712667508119466382354072731648

λ> compuestos [2,3,5] !! (10^5)

290237644800000000000000000000000000000

Soluciones

import Data.Numbers.Primes (primeFactors)

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

compuestos1 :: [Integer] -> [Integer]
compuestos1 ps =
  [n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen
-- a ps. Por ejemplo, 
--    esCompuesto [2,3,7]    28  ==  True
--    esCompuesto [2,3,7]   140  ==  False
--    esCompuesto [2,3,5,7] 140  ==  True
esCompuesto :: [Integer] -> Integer -> Bool
esCompuesto ps n =
  subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs
-- pertenecen a ys. Por ejemplo, 
--    subconjunto [2,7,2] [7,5,2]  ==  True
--    subconjunto [2,7,3] [7,5,2]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

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

compuestos2 :: [Integer] -> [Integer]
compuestos2 ps =
   1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de
-- ps por los números compuestos con ps. Por ejemplo,
--    λ> take 8 (compuestos4 [2,5,7])
--    [1,2,4,5,7,8,10,14]
--    λ> map (take 6) (combinaciones [2,5,7])
--    [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]
combinaciones :: [Integer] -> [[Integer]]
combinaciones ps =
  [[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo, 
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: [[Integer]] -> [Integer]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista
-- ordenadas xs e ys. Por ejemplo,  
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla []     ys              = ys
mezcla xs     []              = xs
mezcla us@(x:xs) vs@(y:ys) | x == y     = x : mezcla xs ys
                           | x < y      = x : mezcla xs vs
                           | otherwise  = y : mezcla us ys

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

compuestos3 :: [Integer] -> [Integer]
compuestos3 [] = [1]
compuestos3 (p:ps) =
  mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

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

compuestos4 :: [Integer] -> [Integer]
compuestos4 ps = foldl aux xs (tail ps)
  where p        = head ps
        xs       = [p^k | k <- [0..]]
        aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

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

compuestos5 :: [Integer] -> [Integer]
compuestos5 = foldl aux [1] 
  where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

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

compuestos6 :: [Integer] -> [Integer]
compuestos6 xs = aux
  where aux = 1 : mezclas xs aux
        mezclas []     _  = []
        mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

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

--    λ> compuestos1 [2,3,5] !! 300
--    84375
--    (5.85 secs, 2,961,101,088 bytes)
--    λ> compuestos2 [2,3,5] !! 300
--    84375
--    (3.54 secs, 311,137,952 bytes)
--    λ> compuestos2 [2,3,5] !! 400
--    312500
--    (13.01 secs, 1,229,801,184 bytes)
--    λ> compuestos3 [2,3,5] !! 400
--    312500
--    (0.02 secs, 2,066,152 bytes)
--    λ> compuestos3 [2,3,5] !! 20000
--    15441834907098675000000
--    (1.57 secs, 203,061,864 bytes)
--    λ> compuestos4 [2,3,5] !! 20000
--    15441834907098675000000
--    (0.40 secs, 53,335,080 bytes)
--    λ> compuestos4 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.25 secs, 170,058,496 bytes)
--    λ> compuestos5 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.26 secs, 170,104,648 bytes)
--    λ> compuestos6 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (0.26 secs, 40,490,280 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

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

compuestos1 :: [Integer] -> [Integer]

compuestos1 ps =

[n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen

-- a ps. Por ejemplo,

-- esCompuesto [2,3,7] 28 == True

-- esCompuesto [2,3,7] 140 == False

-- esCompuesto [2,3,5,7] 140 == True

esCompuesto :: [Integer] -> Integer -> Bool

esCompuesto ps n =

subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs

-- pertenecen a ys. Por ejemplo,

-- subconjunto [2,7,2] [7,5,2] == True

-- subconjunto [2,7,3] [7,5,2] == False

subconjunto :: Eq a => [a] -> [a] -> Bool

subconjunto xs ys =

all (`elem` ys) xs

-- 2ª solución

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

compuestos2 :: [Integer] -> [Integer]

compuestos2 ps =

1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de

-- ps por los números compuestos con ps. Por ejemplo,

-- λ> take 8 (compuestos4 [2,5,7])

-- [1,2,4,5,7,8,10,14]

-- λ> map (take 6) (combinaciones [2,5,7])

-- [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]

combinaciones :: [Integer] -> [[Integer]]

combinaciones ps =

[[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

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

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

mezclaTodas :: [[Integer]] -> [Integer]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista

-- ordenadas xs e ys. Por ejemplo,

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

mezcla [] ys = ys

mezcla xs [] = xs

mezcla us@(x:xs) vs@(y:ys) | x == y = x : mezcla xs ys

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª solución

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

compuestos3 :: [Integer] -> [Integer]

compuestos3 [] = [1]

compuestos3 (p:ps) =

mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

-- 4ª solución

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

compuestos4 :: [Integer] -> [Integer]

compuestos4 ps = foldl aux xs (tail ps)

where p = head ps

xs = [p^k | k <- [0..]]

aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución

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

compuestos5 :: [Integer] -> [Integer]

compuestos5 = foldl aux [1]

where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución

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

compuestos6 :: [Integer] -> [Integer]

compuestos6 xs = aux

where aux = 1 : mezclas xs aux

mezclas [] _ = []

mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

-- Comparación de eficiencia

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

-- λ> compuestos1 [2,3,5] !! 300

-- 84375

-- (5.85 secs, 2,961,101,088 bytes)

-- λ> compuestos2 [2,3,5] !! 300

-- 84375

-- (3.54 secs, 311,137,952 bytes)

-- λ> compuestos2 [2,3,5] !! 400

-- 312500

-- (13.01 secs, 1,229,801,184 bytes)

-- λ> compuestos3 [2,3,5] !! 400

-- 312500

-- (0.02 secs, 2,066,152 bytes)

-- λ> compuestos3 [2,3,5] !! 20000

-- 15441834907098675000000

-- (1.57 secs, 203,061,864 bytes)

-- λ> compuestos4 [2,3,5] !! 20000

-- 15441834907098675000000

-- (0.40 secs, 53,335,080 bytes)

-- λ> compuestos4 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.25 secs, 170,058,496 bytes)

-- λ> compuestos5 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.26 secs, 170,104,648 bytes)

-- λ> compuestos6 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (0.26 secs, 40,490,280 bytes)

Notas de evaluación acumulada

PorJosé A. Alonso 19-abril-201826-abril-2018

La evaluación acumulada, las notas se calculan recursivamente con la siguiente función

   N(1) = E(1)
   N(k) = máximo(E(k), 0.4*N(k-1)+0.6*E(k))

1 2	N(1) = E(1) N(k) = máximo(E(k), 0.4N(k-1)+0.6E(k))

donde E(k) es la nota del examen k. Por ejemplo, si las notas de los exámenes son [3,7,6,3] entonces las acumuladas son [3.0,7.0,6.4,4.4]

Las notas e los exámenes se encuentran en ficheros CSV con los valores separados por comas. Cada línea representa la nota de un alumno, el primer valor es el identificador del alumno y los restantes son sus notas. Por ejemplo, el contenido de examenes.csv es

   juaruigar,3,7,9,3
   evadialop,3,6,7,4
   carrodmes,0,9,8,7

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

   acumuladas      :: [Double] -> [Double]
   notasAcumuladas :: FilePath -> FilePath -> IO ()

1 2	acumuladas :: [Double] -> [Double] notasAcumuladas :: FilePath -> FilePath -> IO ()

tales que

(acumuladas xs) es la lista de las notas acumuladas (redondeadas con un decimal) de los notas de los exámenes xs. Por ejemplo,

     acumuladas [2,5]      ==  [2.0,5.0]
     acumuladas [5,2]      ==  [5.0,3.2]
     acumuladas [3,7,6,3]  ==  [3.0,7.0,6.4,4.4]
     acumuladas [3,6,7,3]  ==  [3.0,6.0,7.0,4.6]

acumuladas [2,5] == [2.0,5.0]

acumuladas [5,2] == [5.0,3.2]

acumuladas [3,7,6,3] == [3.0,7.0,6.4,4.4]

acumuladas [3,6,7,3] == [3.0,6.0,7.0,4.6]

(notasAcumuladas f1 f2) que escriba en el fichero f2 las notas acumuladas correspondientes a las notas de los exámenes del fichero f1. Por ejemplo, al evaluar

     notasAcumuladas "examenes.csv" "acumuladas.csv"

1	notasAcumuladas "examenes.csv" "acumuladas.csv"

escribe en el fichero acumuladas.csv

     juaruigar,3.0,7.0,9.0,5.4
     evadialop,3.0,6.0,7.0,5.2
     carrodmes,0.0,9.0,8.4,7.6

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

-- Definicioń de acumuladas
-- ========================

acumuladas :: [Double] -> [Double]
acumuladas = reverse . aux . reverse
  where aux []     = []
        aux [x]    = [x]
        aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys 
          where (y:ys) = aux xs

--    conUnDecimal 7.26  ==  7.3
--    conUnDecimal 7.24  ==  7.2
conUnDecimal :: Double -> Double
conUnDecimal x = fromIntegral (round (10*x)) / 10

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

notasAcumuladas :: FilePath -> FilePath -> IO ()
notasAcumuladas f1 f2 = do
  cs <- readFile f1
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             . cadenaALista
                             )
                             (contenidoALineasDeNotas cs)))

--   λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n  \n"
--   ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]
contenidoALineasDeNotas :: String -> [String]
contenidoALineasDeNotas = filter esLineaDeNotas . lines
  where esLineaDeNotas = elem ','

--    cadenaALista "a,b c,d"            ==  ["a","b c","d"]
--    cadenaALista "juaruigar,3,7,6,3"  ==  ["juaruigar","3","7","6","3"]
cadenaALista :: String -> [String]
cadenaALista cs
  | tieneComas cs = d : cadenaALista ds
  | otherwise     = [cs]
  where (d,_:ds)   = span (/=',') cs
        tieneComas = elem ','

--    λ> listaANota ["juaruigar","3","7","6","3"]
--    ("juaruigar",[3.0,7.0,6.0,3.0])
listaANota :: [String] -> (String,[Double])
listaANota (x:xs) = (x,map read xs)

--   λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])
--   ("juaruigar",[3.0,7.0,6.4,4.4])
notaAAcumuladas :: (String,[Double]) -> (String,[Double])
notaAAcumuladas (x,xs) = (x, acumuladas xs)

--    λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])
--    "juaruigar,3.0,7.0,6.4,4.4"
acumuladaACadena :: (String,[Double]) -> String
acumuladaACadena (x,xs) =
  x ++ "," ++ tail (init (show xs))

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()
notasAcumuladas2 f1 f2 = do
  cs <- readFile f1
  let (Right csv) = parseCSV f1 cs
  let notas = [xs | xs <- csv, length xs > 1]
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             )
                             notas))

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

conUnDecimal x = fromIntegral (round (10*x)) / 10

-- 1ª definición de notasAcumuladas

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

notasAcumuladas :: FilePath -> FilePath -> IO ()

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

-- λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n \n"

-- ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

-- cadenaALista "a,b c,d" == ["a","b c","d"]

-- cadenaALista "juaruigar,3,7,6,3" == ["juaruigar","3","7","6","3"]

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

where (d,_:ds) = span (/=',') cs

tieneComas = elem ','

-- λ> listaANota ["juaruigar","3","7","6","3"]

-- ("juaruigar",[3.0,7.0,6.0,3.0])

listaANota :: [String] -> (String,[Double])

listaANota (x:xs) = (x,map read xs)

-- λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])

-- ("juaruigar",[3.0,7.0,6.4,4.4])

notaAAcumuladas :: (String,[Double]) -> (String,[Double])

notaAAcumuladas (x,xs) = (x, acumuladas xs)

-- λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])

-- "juaruigar,3.0,7.0,6.4,4.4"

acumuladaACadena :: (String,[Double]) -> String

acumuladaACadena (x,xs) =

x ++ "," ++ tail (init (show xs))

-- 2ª definición de notasAcumuladas

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

let notas = [xs | xs <- csv, length xs > 1]

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Cálculo de pi mediante la serie de Nilakantha

PorJosé A. Alonso 11-abril-201825-marzo-2022

Una serie infinita para el cálculo de pi, publicada por Nilakantha en el siglo XV, es

Definir las funciones

   aproximacionPi :: Int -> Double
   tabla          :: FilePath -> [Int] -> IO ()

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

tales que

(aproximacionPi n) es la n-ésima aproximación de pi obtenido sumando los n primeros términos de la serie de Nilakantha. Por ejemplo,

     aproximacionPi 0        ==  3.0
     aproximacionPi 1        ==  3.1666666666666665
     aproximacionPi 2        ==  3.1333333333333333
     aproximacionPi 3        ==  3.145238095238095
     aproximacionPi 4        ==  3.1396825396825396
     aproximacionPi 5        ==  3.1427128427128426
     aproximacionPi 10       ==  3.1414067184965018
     aproximacionPi 100      ==  3.1415924109719824
     aproximacionPi 1000     ==  3.141592653340544
     aproximacionPi 10000    ==  3.141592653589538
     aproximacionPi 100000   ==  3.1415926535897865
     aproximacionPi 1000000  ==  3.141592653589787
     pi                      ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.1666666666666665

aproximacionPi 2 == 3.1333333333333333

aproximacionPi 3 == 3.145238095238095

aproximacionPi 4 == 3.1396825396825396

aproximacionPi 5 == 3.1427128427128426

aproximacionPi 10 == 3.1414067184965018

aproximacionPi 100 == 3.1415924109719824

aproximacionPi 1000 == 3.141592653340544

aproximacionPi 10000 == 3.141592653589538

aproximacionPi 100000 == 3.1415926535897865

aproximacionPi 1000000 == 3.141592653589787

pi == 3.141592653589793

(tabla f ns) escribe en el fichero f las n-ésimas aproximaciones de pi, donde n toma los valores de la lista ns, junto con sus errores. Por ejemplo, al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,10..100]

1	tabla "AproximacionesPi.txt" [0,10..100]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|   10 | 3.141406718497 | 0.000185935093 |
|   20 | 3.141565734659 | 0.000026918931 |
|   30 | 3.141584272675 | 0.000008380915 |
|   40 | 3.141589028941 | 0.000003624649 |
|   50 | 3.141590769850 | 0.000001883740 |
|   60 | 3.141591552546 | 0.000001101044 |
|   70 | 3.141591955265 | 0.000000698325 |
|   80 | 3.141592183260 | 0.000000470330 |
|   90 | 3.141592321886 | 0.000000331704 |
|  100 | 3.141592410972 | 0.000000242618 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 10 | 3.141406718497 | 0.000185935093 |

| 20 | 3.141565734659 | 0.000026918931 |

| 30 | 3.141584272675 | 0.000008380915 |

| 40 | 3.141589028941 | 0.000003624649 |

| 50 | 3.141590769850 | 0.000001883740 |

| 60 | 3.141591552546 | 0.000001101044 |

| 70 | 3.141591955265 | 0.000000698325 |

| 80 | 3.141592183260 | 0.000000470330 |

| 90 | 3.141592321886 | 0.000000331704 |

| 100 | 3.141592410972 | 0.000000242618 |

+------+----------------+----------------+

al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,500..5000]

1	tabla "AproximacionesPi.txt" [0,500..5000]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|  500 | 3.141592651602 | 0.000000001988 |
| 1000 | 3.141592653341 | 0.000000000249 |
| 1500 | 3.141592653516 | 0.000000000074 |
| 2000 | 3.141592653559 | 0.000000000031 |
| 2500 | 3.141592653574 | 0.000000000016 |
| 3000 | 3.141592653581 | 0.000000000009 |
| 3500 | 3.141592653584 | 0.000000000006 |
| 4000 | 3.141592653586 | 0.000000000004 |
| 4500 | 3.141592653587 | 0.000000000003 |
| 5000 | 3.141592653588 | 0.000000000002 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 500 | 3.141592651602 | 0.000000001988 |

| 1000 | 3.141592653341 | 0.000000000249 |

| 1500 | 3.141592653516 | 0.000000000074 |

| 2000 | 3.141592653559 | 0.000000000031 |

| 2500 | 3.141592653574 | 0.000000000016 |

| 3000 | 3.141592653581 | 0.000000000009 |

| 3500 | 3.141592653584 | 0.000000000006 |

| 4000 | 3.141592653586 | 0.000000000004 |

| 4500 | 3.141592653587 | 0.000000000003 |

| 5000 | 3.141592653588 | 0.000000000002 |

+------+----------------+----------------+

Soluciones

import Text.Printf

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

aproximacionPi :: Int -> Double
aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]
serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]
terminosNilakantha = zipWith (/) numeradores denominadores
  where numeradores   = 3 : cycle [4,-4]
        denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 = aux 3 2 1
  where aux x _ _ 0 = x
        aux x y z m =
          aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

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

--    λ> aproximacionPi (2*10^5)
--    3.141592653589787
--    (0.82 secs, 145,964,728 bytes)
--    λ> aproximacionPi2 (2*10^5)
--    3.141592653589787
--    (2.27 secs, 432,463,496 bytes)
--    λ> aproximacionPi (3*10^5)
--    3.141592653589787
--    (0.34 secs, 73,056,488 bytes)
--    λ> aproximacionPi2 (3*10^5)
--    3.141592653589787
--    (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla
-- ===================

tabla :: FilePath -> [Int] -> IO ()
tabla f ns = do
  writeFile f (tablaAux ns)

tablaAux :: [Int] -> String
tablaAux ns =
     linea
  ++ cabecera
  ++ linea
  ++ concat [printf "| %4d | %.12f | %.12f |\n" n a e
            | n <- ns
            , let a = aproximacionPi n
            , let e = abs (pi - a)]
  ++ linea

linea :: String
linea = "+------+----------------+----------------+\n"

cabecera :: String
cabecera = "| n    | Aproximación   | Error          |\n"

import Text.Printf

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]

serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]

terminosNilakantha = zipWith (/) numeradores denominadores

where numeradores = 3 : cycle [4,-4]

denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 = aux 3 2 1

where aux x _ _ 0 = x

aux x y z m =

aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

-- Comparación de eficiencia

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

-- λ> aproximacionPi (2*10^5)

-- 3.141592653589787

-- (0.82 secs, 145,964,728 bytes)

-- λ> aproximacionPi2 (2*10^5)

-- 3.141592653589787

-- (2.27 secs, 432,463,496 bytes)

-- λ> aproximacionPi (3*10^5)

-- 3.141592653589787

-- (0.34 secs, 73,056,488 bytes)

-- λ> aproximacionPi2 (3*10^5)

-- 3.141592653589787

-- (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla

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

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

tabla f ns = do

writeFile f (tablaAux ns)

tablaAux :: [Int] -> String

tablaAux ns =

linea

++ cabecera

++ linea

++ concat [printf "| %4d | %.12f | %.12f |\n" n a e

| n <- ns

, let a = aproximacionPi n

, let e = abs (pi - a)]

++ linea

linea :: String

linea = "+------+----------------+----------------+\n"

cabecera :: String

cabecera = "| n | Aproximación | Error |\n"

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.

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

Vértices de un cuadrado

PorJosé A. Alonso 16-febrero-20187-marzo-2018

Definir la función

   esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

1	esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

tal que (esCuadrado p q r s) se verifica si los puntos p, q, r y s son los vértices de un cuadrado. Por ejemplo,

   esCuadrado (0,0) (0,1) (1,1) (1,0)    == True
   esCuadrado (0,0) (2,1) (3,-1) (1, -2) == True
   esCuadrado (0,0) (1,1) (0,1) (1,0)    == True
   esCuadrado (1,1) (1,1) (1,1) (1,1)    == True
   esCuadrado (0,0) (0,2) (3,2) (3,0)    == False
   esCuadrado (0,0) (3,4) (8,4) (5,0)    == False
   esCuadrado (0,0) (0,0) (1,1) (0,0)    == False
   esCuadrado (0,0) (0,0) (1,0) (0,1)    == False
   esCuadrado (0,0) (1,0) (0,1) (-1,-1)  == False

esCuadrado (0,0) (0,1) (1,1) (1,0) == True

esCuadrado (0,0) (2,1) (3,-1) (1, -2) == True

esCuadrado (0,0) (1,1) (0,1) (1,0) == True

esCuadrado (1,1) (1,1) (1,1) (1,1) == True

esCuadrado (0,0) (0,2) (3,2) (3,0) == False

esCuadrado (0,0) (3,4) (8,4) (5,0) == False

esCuadrado (0,0) (0,0) (1,1) (0,0) == False

esCuadrado (0,0) (0,0) (1,0) (0,1) == False

esCuadrado (0,0) (1,0) (0,1) (-1,-1) == False

Soluciones

import Data.List (sort, tails)

esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool
esCuadrado p q r s = and [a == b, b == c, c == d, e == f, a + b == e]
  where [a,b,c,d,e,f] = sort (distancias p q r s)

-- (distancias p q r s) es la lista de los cuadrados de las longitudes
-- de los lados y de las diagonales del cuadrilátero cuyos vértices son
-- los puntos p, q, r y s. Por ejemplo,
--    distancias (0,0) (0,1) (1,1) (1,0)  ==  [1,2,1,1,2,1]
--    distancias (0,0) (3,4) (8,4) (5,0)  ==  [25,80,25,25,20,25]
--    distancias (0,0) (0,2) (3,2) (3,0)  ==  [4,13,9,9,13,4]
--    distancias (0,0) (0,0) (1,1) (0,0)  ==  [0,2,0,2,0,2]
--    distancias (0,0) (0,0) (1,0) (0,1)  ==  [0,1,1,1,1,2]
distancias :: Num a => (a,a) -> (a,a) -> (a,a) -> (a,a) -> [a]
distancias p q r s =
  [l | (h:t) <- tails [p,q,r,s], l <- map (dist h) t]

-- (dist p q) es el cuadrado de la distancia del punto p al q. Por
-- ejemplo,
--    dist (6,4) (3,8)  ==  25
dist :: Num a => (a,a) -> (a,a) -> a
dist (x1,y1) (x2,y2) = (x2-x1)^2 + (y2-y1)^2

import Data.List (sort, tails)

esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

esCuadrado p q r s = and [a == b, b == c, c == d, e == f, a + b == e]

where [a,b,c,d,e,f] = sort (distancias p q r s)

-- (distancias p q r s) es la lista de los cuadrados de las longitudes

-- de los lados y de las diagonales del cuadrilátero cuyos vértices son

-- los puntos p, q, r y s. Por ejemplo,

-- distancias (0,0) (0,1) (1,1) (1,0) == [1,2,1,1,2,1]

-- distancias (0,0) (3,4) (8,4) (5,0) == [25,80,25,25,20,25]

-- distancias (0,0) (0,2) (3,2) (3,0) == [4,13,9,9,13,4]

-- distancias (0,0) (0,0) (1,1) (0,0) == [0,2,0,2,0,2]

-- distancias (0,0) (0,0) (1,0) (0,1) == [0,1,1,1,1,2]

distancias :: Num a => (a,a) -> (a,a) -> (a,a) -> (a,a) -> [a]

distancias p q r s =

[l | (h:t) <- tails [p,q,r,s], l <- map (dist h) t]

-- (dist p q) es el cuadrado de la distancia del punto p al q. Por

-- ejemplo,

-- dist (6,4) (3,8) == 25

dist :: Num a => (a,a) -> (a,a) -> a

dist (x1,y1) (x2,y2) = (x2-x1)^2 + (y2-y1)^2

Fractal hexagonal

PorJosé A. Alonso 16-enero-201819-febrero-2018

Escribir, usando CodeWorld, un programa para dibujar el fractal hexagonal que se muestra en la siguiente animación

Las 4 primeras fases de la animación son

Fase 0:
Fase 1:
Fase 2:
Fase 3:

Nota: Este ejercicio ha sido propuesto por Agustín Martín Aguera.

Soluciones

import CodeWorld

main :: IO()
main = animationOf (hexagono . s)

hexagono :: Int -> Picture
hexagono 0 =
  colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]
  where c = 9 * sin (pi / 3)
hexagono n =
  pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))
  where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int
s t = mod (floor t) 5

import CodeWorld

main :: IO()

main = animationOf (hexagono . s)

hexagono :: Int -> Picture

hexagono 0 =

colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]

where c = 9 * sin (pi / 3)

hexagono n =

pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))

where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int

s t = mod (floor t) 5

Suma de las hojas de mínimo nivel

PorJosé A. Alonso 20-diciembre-201727-diciembre-2017

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a) 
     deriving (Eq, Show)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

         1 
       /   \
      2     3
     / \   / \
    4   5 6   7
       / \
      8   9

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 1 (N 2 (H 4)
                      (N 5 (H 8) (H 9)))
                 (N 3 (H 6) (H 7))

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

En el árbol anterior, los valores de las hojas de menor nivel son 4, 6 y 7 cuya suma es 17.

Definir la función

   suma :: Num t => Arbol t -> t

1	suma :: Num t => Arbol t -> t

tal que (suma a) es la suma de los valores de las hojas de menor nivel del árbol a. Por ejemplo,

   suma ejArbol                                    ==  17
   suma (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7)))  ==  22
   suma (N 1 (H 2) (N 3 (H 6) (H 7)))              ==  2
   suma (N 1 (H 2) (H 3))                          ==  5
   suma (H 2)                                      ==  2

suma ejArbol == 17

suma (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7))) == 22

suma (N 1 (H 2) (N 3 (H 6) (H 7))) == 2

suma (N 1 (H 2) (H 3)) == 5

suma (H 2) == 2

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a) 
  deriving (Eq, Show)

ejArbol :: Arbol Int
ejArbol = N 1 (N 2 (H 4)
                   (N 5 (H 8) (H 9)))
              (N 3 (H 6) (H 7))
                      
suma :: Num t => Arbol t -> t
suma a = aux [a]
  where aux as | null xs   = aux (concat [[i,d] | (N _ i d) <- as])
               | otherwise = sum xs
          where xs = [x | (H x) <- as]

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

suma :: Num t => Arbol t -> t

suma a = aux [a]

where aux as | null xs = aux (concat [[i,d] | (N _ i d) <- as])

| otherwise = sum xs

where xs = [x | (H x) <- as]

Bosque de recorridos del autobús

PorJosé A. Alonso 13-diciembre-201720-diciembre-2017

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ejArbol1 = Node 3 [Node 5 [Node 9 []], Node 7 []]
   ejArbol2 = Node 8 [Node 4 []]

1 2	ejArbol1 = Node 3 [Node 5 [Node 9 []], Node 7 []] ejArbol2 = Node 8 [Node 4 []]

También se pueden definir bosques. Por ejemplo,

   ejBosque = [ejArbol1, ejArbol2]

1	ejBosque = [ejArbol1, ejArbol2]

Se pueden dibujar los bosques con la función drawForest. Por ejemplo,

   λ> putStrLn (drawForest (map (fmap show) ejBosque))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7
   
   8
   |
   `- 4

λ> putStrLn (drawForest (map (fmap show) ejBosque))

+- 5

| |

| `- 9

`- 7

`- 4

Usando la notación de los ejercicios anteriores para las subidas y bajadas en el autobús, definir la función

   bosqueRecorridos :: Int -> Int -> Forest (Int,Int)

1	bosqueRecorridos :: Int -> Int -> Forest (Int,Int)

tal que (bosqueRecorridos n m) es el bosque cuyas ramas son los recorridos correctos en un autobús de capacidad n y usando m paradas. Por ejemplo,

   λ> putStrLn (drawForest (map (fmap show) (bosqueRecorridos 2 3)))
   (0,0)
   |
   +- (0,0)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  `- (2,0)
   |
   +- (1,0)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  `- (2,1)
   |
   `- (2,0)
      |
      +- (0,0)
      |
      +- (0,1)
      |
      +- (1,1)
      |
      +- (0,2)
      |
      +- (1,2)
      |
      `- (2,2)
   
   (1,0)
   |
   +- (0,0)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  `- (2,1)
   |
   +- (1,0)
   |  |
   |  +- (0,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  +- (0,2)
   |  |
   |  +- (1,2)
   |  |
   |  `- (2,2)
   |
   +- (0,1)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  `- (2,0)
   |
   +- (1,1)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  `- (2,1)
   |
   `- (2,1)
      |
      +- (0,0)
      |
      +- (0,1)
      |
      +- (1,1)
      |
      +- (0,2)
      |
      +- (1,2)
      |
      `- (2,2)
   
   (2,0)
   |
   +- (0,0)
   |  |
   |  +- (0,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  +- (0,2)
   |  |
   |  +- (1,2)
   |  |
   |  `- (2,2)
   |
   +- (0,1)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  `- (2,1)
   |
   +- (1,1)
   |  |
   |  +- (0,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  +- (0,2)
   |  |
   |  +- (1,2)
   |  |
   |  `- (2,2)
   |
   +- (0,2)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  `- (2,0)
   |
   +- (1,2)
   |  |
   |  +- (0,0)
   |  |
   |  +- (1,0)
   |  |
   |  +- (0,1)
   |  |
   |  +- (1,1)
   |  |
   |  `- (2,1)
   |
   `- (2,2)
      |
      +- (0,0)
      |
      +- (0,1)
      |
      +- (1,1)
      |
      +- (0,2)
      |
      +- (1,2)
      |
      `- (2,2)

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

λ> putStrLn (drawForest (map (fmap show) (bosqueRecorridos 2 3)))

(0,0)

+- (0,0)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| `- (2,0)

+- (1,0)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| `- (2,1)

`- (2,0)

+- (0,0)

+- (0,1)

+- (1,1)

+- (0,2)

+- (1,2)

`- (2,2)

(1,0)

+- (0,0)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| `- (2,1)

+- (1,0)

| |

| +- (0,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| +- (0,2)

| |

| +- (1,2)

| |

| `- (2,2)

+- (0,1)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| `- (2,0)

+- (1,1)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| `- (2,1)

`- (2,1)

+- (0,0)

+- (0,1)

+- (1,1)

+- (0,2)

+- (1,2)

`- (2,2)

(2,0)

+- (0,0)

| |

| +- (0,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| +- (0,2)

| |

| +- (1,2)

| |

| `- (2,2)

+- (0,1)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| `- (2,1)

+- (1,1)

| |

| +- (0,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| +- (0,2)

| |

| +- (1,2)

| |

| `- (2,2)

+- (0,2)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| `- (2,0)

+- (1,2)

| |

| +- (0,0)

| |

| +- (1,0)

| |

| +- (0,1)

| |

| +- (1,1)

| |

| `- (2,1)

`- (2,2)

+- (0,0)

+- (0,1)

+- (1,1)

+- (0,2)

+- (1,2)

`- (2,2)

en donde la última rama representa el recorrido [(2,0),(2,2),(2,2)].

Soluciones

import Data.Tree

bosqueRecorridos :: Int -> Int -> Forest (Int, Int)
bosqueRecorridos c p = aux p 0
  where aux 0 _ = []
        aux p' a = [Node (s,b) (aux (p'-1) (a+s-b))
                   | b <- [0..a]
                   , s <- [0..c-a+b]]

import Data.Tree

bosqueRecorridos :: Int -> Int -> Forest (Int, Int)

bosqueRecorridos c p = aux p 0

where aux 0 _ = []

aux p' a = [Node (s,b) (aux (p'-1) (a+s-b))

| b <- [0..a]

, s <- [0..c-a+b]]

Caminos minimales en un árbol numérico

PorJosé A. Alonso 7-diciembre-201725-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u*v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

(mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Sumas de dos cuadrados

PorJosé A. Alonso 24-noviembre-20174-diciembre-2017

Definir la función

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

1	sumasDe2Cuadrados :: Integer -> [(Integer, Integer)]

tal que (sumasDe2Cuadrados n) es la lista de los pares de números tales que la suma de sus cuadrados es n y el primer elemento del par es mayor o igual que el segundo. Por ejemplo,

   sumasDe2Cuadrados 25                ==  [(5,0),(4,3)]
   sumasDe2Cuadrados 32                ==  [(4,4)]
   sumasDe2Cuadrados 55                ==  []
   sumasDe2Cuadrados 850               ==  [(29,3),(27,11),(25,15)]
   length (sumasDe2Cuadrados (10^12))  ==  7

sumasDe2Cuadrados 25 == [(5,0),(4,3)]

sumasDe2Cuadrados 32 == [(4,4)]

sumasDe2Cuadrados 55 == []

sumasDe2Cuadrados 850 == [(29,3),(27,11),(25,15)]

length (sumasDe2Cuadrados (10^12)) == 7

Soluciones

-- 1ª definición
sumasDe2Cuadrados1 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados1 n = 
  [(x,y) | x <- [n,n-1..0]
         , y <- [0..x]
         , x*x+y*y == n]

-- 2ª definición:
sumasDe2Cuadrados2 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados2 n = 
  [(x,y) | x <- [a,a-1..0]
         , y <- [0..x]
         , x*x+y*y == n]
  where a = (floor . sqrt . fromIntegral) n

-- 3ª definición
sumasDe2Cuadrados3 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados3 n =
  [(raizEntera x, raizEntera y)
  | y <- takeWhile (<= n `div` 2) cuadrados
  , let x = n - y
  , esCuadrado x]

cuadrados :: [Integer]
cuadrados = map (^2) [0..]

esCuadrado :: Integer -> Bool
esCuadrado x =
  x == y * y
  where y = raizEntera x
  
raizEntera :: Integer -> Integer
raizEntera x =
  (floor . sqrt . fromIntegral) x

-- 4ª definición
sumasDe2Cuadrados4 :: Integer -> [(Integer, Integer)]
sumasDe2Cuadrados4 n = aux ((floor . sqrt . fromIntegral) n) 0 
  where aux x y | x < y          = [] 
                | x*x + y*y <  n = aux x (y+1)
                | x*x + y*y == n = (x,y) : aux (x-1) (y+1)
                | otherwise      = aux (x-1) y

-- Comparación de eficiencia
--    λ> sumasDe2Cuadrados1 2020
--    [(42,16),(38,24)]
--    (4.29 secs, 621,601,336 bytes)
--    λ> sumasDe2Cuadrados2 2020
--    [(42,16),(38,24)]
--    (0.01 secs, 488,496 bytes)
--    λ> sumasDe2Cuadrados3 2020
--    [(42,16),(38,24)]
--    (0.02 secs, 197,256 bytes)
--    λ> sumasDe2Cuadrados4 2020
--    [(42,16),(38,24)]
--    (0.01 secs, 175,088 bytes)
--
--    λ> length (sumasDe2Cuadrados2 48612265)
--    32
--    (51.25 secs, 7,395,035,904 bytes)
--    λ> length (sumasDe2Cuadrados3 48612265)
--    32
--    (0.06 secs, 8,368,296 bytes)
--    λ> length (sumasDe2Cuadrados4 48612265)
--    32
--    (0.04 secs, 3,483,168 bytes)
--    
--    λ> length (sumasDe2Cuadrados3 (10^12))
--    7
--    (7.32 secs, 1,137,167,688 bytes)
--    λ> length (sumasDe2Cuadrados4 (10^12))
--    7
--    (3.64 secs, 480,776,736 bytes)

-- 1ª definición

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

sumasDe2Cuadrados1 n =

[(x,y) | x <- [n,n-1..0]

, y <- [0..x]

, x*x+y*y == n]

-- 2ª definición:

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

sumasDe2Cuadrados2 n =

[(x,y) | x <- [a,a-1..0]

, y <- [0..x]

, x*x+y*y == n]

where a = (floor . sqrt . fromIntegral) n

-- 3ª definición

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

sumasDe2Cuadrados3 n =

[(raizEntera x, raizEntera y)

| y <- takeWhile (<= n `div` 2) cuadrados

, let x = n - y

, esCuadrado x]

cuadrados :: [Integer]

cuadrados = map (^2) [0..]

esCuadrado :: Integer -> Bool

esCuadrado x =

x == y * y

where y = raizEntera x

raizEntera :: Integer -> Integer

raizEntera x =

(floor . sqrt . fromIntegral) x

-- 4ª definición

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

sumasDe2Cuadrados4 n = aux ((floor . sqrt . fromIntegral) n) 0

where aux x y | x < y = []

| x*x + y*y < n = aux x (y+1)

| x*x + y*y == n = (x,y) : aux (x-1) (y+1)

| otherwise = aux (x-1) y

-- Comparación de eficiencia

-- λ> sumasDe2Cuadrados1 2020

-- [(42,16),(38,24)]

-- (4.29 secs, 621,601,336 bytes)

-- λ> sumasDe2Cuadrados2 2020

-- [(42,16),(38,24)]

-- (0.01 secs, 488,496 bytes)

-- λ> sumasDe2Cuadrados3 2020

-- [(42,16),(38,24)]

-- (0.02 secs, 197,256 bytes)

-- λ> sumasDe2Cuadrados4 2020

-- [(42,16),(38,24)]

-- (0.01 secs, 175,088 bytes)

-- λ> length (sumasDe2Cuadrados2 48612265)

-- 32

-- (51.25 secs, 7,395,035,904 bytes)

-- λ> length (sumasDe2Cuadrados3 48612265)

-- 32

-- (0.06 secs, 8,368,296 bytes)

-- λ> length (sumasDe2Cuadrados4 48612265)

-- 32

-- (0.04 secs, 3,483,168 bytes)

-- λ> length (sumasDe2Cuadrados3 (10^12))

-- 7

-- (7.32 secs, 1,137,167,688 bytes)

-- λ> length (sumasDe2Cuadrados4 (10^12))

-- 7

-- (3.64 secs, 480,776,736 bytes)

[/schedule]

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico