Ir al contenido principal

Árboles con n elementos

Los árboles binarios se pueden representar con

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

Definir las funciones

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)]
  • 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

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

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