Árbol de subconjuntos

   arbolSubconjuntos       :: [a] -> Tree [a]
   nNodosArbolSubconjuntos :: Integer -> Integer
   sumaNNodos              :: Integer -> Integer

     λ> putStrLn (drawTree (arbolSubconjuntos "abc"))
     abc
     |
     +- bc
     |  |
     |  +- c
     |  |
     |  `- b
     |
     +- ac
     |  |
     |  +- c
     |  |
     |  `- a
     |
     `- ab
        |
        +- b
        |
        `- a

     nNodosArbolSubconjuntos "abc"  ==  10
     nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

     λ> sumaNNodos 3  ==  14
     sumaNNodos (4*10^4) `mod` (7+10^9)  ==  249479844

import Data.List (genericLength, genericTake)
import Data.Tree (Tree (Node))
 
-- Definición de arbolSubconjuntos
-- ===============================
 
arbolSubconjuntos :: [a] -> Tree [a]
arbolSubconjuntos [x] = Node [x] []
arbolSubconjuntos xs =
  Node xs (map arbolSubconjuntos (sinUno xs))
 
-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por
-- ejemplo, 
--    sinUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
sinUno :: [a] -> [[a]]
sinUno xs =
  [ys ++ zs | n <- [0..length xs - 1]
            , let (ys,_:zs) = splitAt n xs]       
 
-- 1ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos :: [a] -> Integer
nNodosArbolSubconjuntos =
  fromIntegral . length . arbolSubconjuntos 
 
-- 2ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos2 :: [a] -> Integer
nNodosArbolSubconjuntos2 = aux . genericLength
  where aux 1 = 1
        aux n = 1 + n * aux (n-1)
 
-- 3ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos3 :: [a] -> Integer
nNodosArbolSubconjuntos3 xs =
  sucNNodos !! (n-1)
  where n = length xs
 
-- sucNNodos es la sucesión de los números de nodos de los árboles de
-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.
--    λ> take 10 sucNNodos
--    [1,3,10,41,206,1237,8660,69281,623530,6235301]
sucNNodos :: [Integer]
sucNNodos =
  1 : map (+ 1) (zipWith (*) [2..] sucNNodos)
 
-- Comparación de eficiencia de nNodosArbolSubconjuntos
-- ====================================================
 
--    λ> nNodosArbolSubconjuntos 10
--    6235301
--    (9.66 secs, 5,491,704,944 bytes)
--    λ> nNodosArbolSubconjuntos2 10
--    6235301
--    (0.00 secs, 145,976 bytes)
--
--    λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))
--    166714
--    (1.07 secs, 2,952,675,472 bytes)
--    λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))
--    166714
--    (1.53 secs, 2,959,020,680 bytes)
 
-- 1ª definición de sumaNNodos
-- ===========================
 
sumaNNodos :: Integer -> Integer
sumaNNodos n =
  sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]
 
-- 2ª definición de sumaNNodos
-- ===========================
 
sumaNNodos2 :: Integer -> Integer
sumaNNodos2 n =
  sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]
 
-- 3ª definición de sumaNNodos
-- ===========================
 
sumaNNodos3 :: Integer -> Integer
sumaNNodos3 n =
  sum (genericTake n sucNNodos)
 
-- Comparación de eficiencia de sumaNNodos
-- =======================================
 
--    λ> sumaNNodos 10 `mod` (7+10^9)
--    6938270
--    (16.00 secs, 9,552,410,688 bytes)
--    λ> sumaNNodos2 10 `mod` (7+10^9)
--    6938270
--    (0.00 secs, 177,632 bytes)
-- 
--    λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)
--    851467820
--    (2.62 secs, 4,622,117,976 bytes)
--    λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)
--    851467820
--    (0.01 secs, 8,645,336 bytes)