enero 2019 – Exercitium

Triángulo de Pascal binario

PorJosé A. Alonso 31-enero-20197-febrero-2019

Los triángulos binarios de Pascal se formas a partir de una lista de ceros y unos usando las reglas del triángulo de Pascal, donde cada uno de los números es suma módulo dos de los dos situados en diagonal por encima suyo. Por ejemplo, los triángulos binarios de Pascal correspondientes a [1,0,1,1,1] y [1,0,1,1,0] son

   1 0 1 1 1   1 0 1 1 0     
    1 1 0 0     1 1 0 1  
     0 1 0       0 1 1   
      1 1         1 0    
       0           1

1 0 1 1 1 1 0 1 1 0

1 1 0 0 1 1 0 1

0 1 0 0 1 1

1 1 1 0

0 1

Sus finales, desde el extremo inferior al extremos superior derecho, son [0,1,0,0,1] y [1,0,1,1,0], respectivamente.

Una lista es Pascal capicúa si es igual a los finales de su triángulo binario de Pascal. Por ejemplo, [1,0,1,1,0] es Pascal capicúa.

Definir las funciones

   trianguloPascalBinario :: [Int] -> [[Int]]
   pascalCapicuas         :: Int -> [[Int]]
   nPascalCapicuas        :: Int -> Integer

trianguloPascalBinario :: [Int] -> [[Int]]

pascalCapicuas :: Int -> [[Int]]

nPascalCapicuas :: Int -> Integer

tales que

(trianguloPascalBinario xs) es el triágulo binario de Pascal correspondiente a la lista xs. Por ejemplo,

     λ> trianguloPascalBinario [1,0,1,1,1]
     [[1,0,1,1,1],[1,1,0,0],[0,1,0],[1,1],[0]]
     λ> trianguloPascalBinario [1,0,1,1,0]
     [[1,0,1,1,0],[1,1,0,1],[0,1,1],[1,0],[1]]

λ> trianguloPascalBinario [1,0,1,1,1]

[[1,0,1,1,1],[1,1,0,0],[0,1,0],[1,1],[0]]

λ> trianguloPascalBinario [1,0,1,1,0]

[[1,0,1,1,0],[1,1,0,1],[0,1,1],[1,0],[1]]

(pascalCapicuas n) es la lista de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> pascalCapicuas 2
     [[0,0],[1,0]]
     λ> pascalCapicuas 3
     [[0,0,0],[0,1,0],[1,0,0],[1,1,0]]
     λ> pascalCapicuas 4
     [[0,0,0,0],[0,1,1,0],[1,0,0,0],[1,1,1,0]]

λ> pascalCapicuas 2

[[0,0],[1,0]]

λ> pascalCapicuas 3

[[0,0,0],[0,1,0],[1,0,0],[1,1,0]]

λ> pascalCapicuas 4

[[0,0,0,0],[0,1,1,0],[1,0,0,0],[1,1,1,0]]

(nPascalCapicuas n) es el número de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> nPascalCapicuas 2
     2
     λ> nPascalCapicuas 3
     4
     λ> nPascalCapicuas 4
     4
     λ> nPascalCapicuas 400
     1606938044258990275541962092341162602522202993782792835301376
     λ> length (show (nPascalCapicuas (10^5)))
     15052
     λ> length (show (nPascalCapicuas (10^6)))
     150515
     λ> length (show (nPascalCapicuas (10^7)))
     1505150

λ> nPascalCapicuas 2

λ> nPascalCapicuas 3

λ> nPascalCapicuas 4

λ> nPascalCapicuas 400

1606938044258990275541962092341162602522202993782792835301376

λ> length (show (nPascalCapicuas (10^5)))

15052

λ> length (show (nPascalCapicuas (10^6)))

150515

λ> length (show (nPascalCapicuas (10^7)))

1505150

Soluciones

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario
-- ====================================

trianguloPascalBinario :: [Int] -> [[Int]]
trianguloPascalBinario xs =
  takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario
-- de Pascal. Por ejemplo,
--    λ> siguiente [1,0,1,1,1]
--    [1,1,0,0]
--    λ> siguiente it
--    [0,1,0]
--    λ> siguiente it
--    [1,1]
--    λ> siguiente it
--    [0]
--    λ> siguiente it
--    []
--    λ> siguiente it
--    []
siguiente :: [Int] -> [Int]
siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

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

trianguloPascalBinario2 :: [Int] -> [[Int]]
trianguloPascalBinario2 = unfoldr f 
  where f [] = Nothing
        f xs = Just (xs, siguiente xs)
 
-- Definición de pascalCapicuas
-- ============================

pascalCapicuas :: Int -> [[Int]]
pascalCapicuas n =
  [xs | xs <- inicios n
      , esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por
-- ejemplo, 
--    λ> inicios 0
--    [[]]
--    λ> inicios 1
--    [[0],[1]]
--    λ> inicios 2
--    [[0,0],[0,1],[1,0],[1,1]]
--    λ> inicios 3
--    [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
inicios :: Int -> [[Int]]
inicios 0 = [[]]
inicios n = map (0:) xss ++ map (1:) xss
  where xss = inicios (n-1)

-- Otra forma de definir inicios es
inicios2 :: Int -> [[Int]]
inicios2 n = sucInicios !! n
  where sucInicios    = iterate siguiente [[]]
        siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal
-- capicúa. Por ejemplo, 
--    esPascalCapicua [1,0,1,1,0]  ==  True
--    esPascalCapicua [1,0,1,1,1]  ==  False
esPascalCapicua :: [Int] -> Bool
esPascalCapicua xs =
  xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los
-- finales del triángulo binarios de xs. Por ejemplo,
--    λ> finalesTrianguloPascalBinario [1,0,1,1,1]
--    [0,1,0,0,1]
finalesTrianguloPascalBinario :: [Int] -> [Int]
finalesTrianguloPascalBinario =
  reverse . map last . trianguloPascalBinario

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

nPascalCapicuas :: Int -> Integer
nPascalCapicuas =
  genericLength . pascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer
nPascalCapicuas2 n =
  2 ^ ((n + 1) `div` 2)

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario

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

trianguloPascalBinario :: [Int] -> [[Int]]

trianguloPascalBinario xs =

takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario

-- de Pascal. Por ejemplo,

-- λ> siguiente [1,0,1,1,1]

-- [1,1,0,0]

-- λ> siguiente it

-- [0,1,0]

-- λ> siguiente it

-- [1,1]

-- λ> siguiente it

-- [0]

-- λ> siguiente it

-- []

-- λ> siguiente it

-- []

siguiente :: [Int] -> [Int]

siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

-- 2ª definición de trianguloPascalBinario

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

trianguloPascalBinario2 :: [Int] -> [[Int]]

trianguloPascalBinario2 = unfoldr f

where f [] = Nothing

f xs = Just (xs, siguiente xs)

-- Definición de pascalCapicuas

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

pascalCapicuas :: Int -> [[Int]]

pascalCapicuas n =

[xs | xs <- inicios n

, esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por

-- ejemplo,

-- λ> inicios 0

-- [[]]

-- λ> inicios 1

-- [[0],[1]]

-- λ> inicios 2

-- [[0,0],[0,1],[1,0],[1,1]]

-- λ> inicios 3

-- [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]

inicios :: Int -> [[Int]]

inicios 0 = [[]]

inicios n = map (0:) xss ++ map (1:) xss

where xss = inicios (n-1)

-- Otra forma de definir inicios es

inicios2 :: Int -> [[Int]]

inicios2 n = sucInicios !! n

where sucInicios = iterate siguiente [[]]

siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal

-- capicúa. Por ejemplo,

-- esPascalCapicua [1,0,1,1,0] == True

-- esPascalCapicua [1,0,1,1,1] == False

esPascalCapicua :: [Int] -> Bool

esPascalCapicua xs =

xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los

-- finales del triángulo binarios de xs. Por ejemplo,

-- λ> finalesTrianguloPascalBinario [1,0,1,1,1]

-- [0,1,0,0,1]

finalesTrianguloPascalBinario :: [Int] -> [Int]

finalesTrianguloPascalBinario =

reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas

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

nPascalCapicuas :: Int -> Integer

nPascalCapicuas =

genericLength . pascalCapicuas

-- 2ª definición de nPascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer

nPascalCapicuas2 n =

2 ^ ((n + 1) `div` 2)

Pensamiento

La envidia de la virtud
hizo a Caín criminal.
¡Gloria a Caín! Hoy el vicio
es lo que se envidia más.

Antonio Machado

Impares en filas del triángulo de Pascal

PorJosé A. Alonso 30-enero-20196-febrero-2019

El triángulo de Pascal es un triángulo de números

         1
        1 1
       1 2 1
     1  3 3  1
    1 4  6  4 1
   1 5 10 10 5 1
  ...............

1 1

1 2 1

1 3 3 1

1 4 6 4 1

1 5 10 10 5 1

...............

construido de la siguiente forma

la primera fila está formada por el número 1;
las filas siguientes se construyen sumando los números adyacentes de la fila superior y añadiendo un 1 al principio y al final de la fila.

Definir las funciones

   imparesPascal          :: [[Integer]]
   nImparesPascal         :: [Int]
   grafica_nImparesPascal :: Int -> IO ()

imparesPascal :: [[Integer]]

nImparesPascal :: [Int]

grafica_nImparesPascal :: Int -> IO ()

tales que

imparesPascal es la lista de los elementos impares en cada una de las filas del triángulo de Pascal. Por ejemplo,

     λ> take 8 imparesPascal
     [[1],[1,1],[1,1],[1,3,3,1],[1,1],[1,5,5,1],[1,15,15,1],[1,7,21,35,35,21,7,1]]

1 2	λ> take 8 imparesPascal [[1],[1,1],[1,1],[1,3,3,1],[1,1],[1,5,5,1],[1,15,15,1],[1,7,21,35,35,21,7,1]]

nImparesPascal es la lista del número de elementos impares en cada una de las filas del triángulo de Pascal. Por ejemplo,

     λ> take 32 nImparesPascal
     [1,2,2,4,2,4,4,8,2,4,4,8,4,8,8,16,2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]
     λ> maximum (take (10^6) nImparesPascal3)
     524288

λ> take 32 nImparesPascal

[1,2,2,4,2,4,4,8,2,4,4,8,4,8,8,16,2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]

λ> maximum (take (10^6) nImparesPascal3)

524288

(grafica_nImparesPascal n) dibuja la gráfica de los n primeros términos de nImparesPascal. Por ejemplo, (grafica_nImparesPascal 50) dibuja

y (grafica_nImparesPascal 100) dibuja

Comprobar con QuickCheck que todos los elementos de nImparesPascal son potencias de dos.

Soluciones

import Data.List (transpose)
import Test.QuickCheck
import Graphics.Gnuplot.Simple

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

imparesPascal :: [[Integer]]
imparesPascal =
  map (filter odd) pascal

-- pascal es la lista de las filas del triángulo de Pascal. Por ejemplo,
--    λ> take 7 pascal
--    [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1]]
pascal :: [[Integer]]
pascal = [1] : map f pascal
  where f xs = zipWith (+) (0:xs) (xs++[0])

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

imparesPascal2 :: [[Integer]]
imparesPascal2 =
  map (filter odd) pascal

pascal2 :: [[Integer]]
pascal2 = iterate f [1]
  where f xs = zipWith (+) (0:xs) (xs++[0])

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

nImparesPascal :: [Int]
nImparesPascal =
  map length imparesPascal

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

nImparesPascal2 :: [Int]
nImparesPascal2 =
  map (length . filter odd) imparesPascal

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

--    λ> take 32 nImparesPascal2
--    [1,2,
--     2,4,
--     2,4,4,8,
--     2,4,4,8,4,8,8,16,
--     2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]
nImparesPascal3 :: [Int]
nImparesPascal3 = 1 : zs
  where zs = 2 : concat (transpose [zs, map (*2) zs])

-- Definición de grafica_nImparesPascal
-- =========================================

grafica_nImparesPascal :: Int -> IO ()
grafica_nImparesPascal n =
  plotListStyle
    [ Key Nothing
    , PNG ("Impares_en_filas_del_triangulo_de_Pascal_" ++ show n ++ ".png")
    ]
    (defaultStyle {plotType = LinesPoints})
    (take n nImparesPascal3)

-- Propiedad de nImparesPascal
-- ===========================

-- La propiedad es
prop_nImparesPascal :: Positive Int -> Bool
prop_nImparesPascal (Positive n) =
  esPotenciaDeDos (nImparesPascal3 !! n)

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por
-- ejemplo,
--    esPotenciaDeDos 16  ==  True
--    esPotenciaDeDos 18  ==  False
esPotenciaDeDos :: Int -> Bool
esPotenciaDeDos 1 = True
esPotenciaDeDos n = even n && esPotenciaDeDos (n `div` 2)

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

import Data.List (transpose)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de imparesPascal

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

imparesPascal :: [[Integer]]

imparesPascal =

map (filter odd) pascal

-- pascal es la lista de las filas del triángulo de Pascal. Por ejemplo,

-- λ> take 7 pascal

-- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1]]

pascal :: [[Integer]]

pascal = [1] : map f pascal

where f xs = zipWith (+) (0:xs) (xs++[0])

-- 2ª definición de imparesPascal

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

imparesPascal2 :: [[Integer]]

imparesPascal2 =

map (filter odd) pascal

pascal2 :: [[Integer]]

pascal2 = iterate f [1]

where f xs = zipWith (+) (0:xs) (xs++[0])

-- 1ª definición de nImparesPascal

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

nImparesPascal :: [Int]

nImparesPascal =

map length imparesPascal

-- 2ª definición de nImparesPascal

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

nImparesPascal2 :: [Int]

nImparesPascal2 =

map (length . filter odd) imparesPascal

-- 3ª definición de nImparesPascal

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

-- λ> take 32 nImparesPascal2

-- [1,2,

-- 2,4,

-- 2,4,4,8,

-- 2,4,4,8,4,8,8,16,

-- 2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]

nImparesPascal3 :: [Int]

nImparesPascal3 = 1 : zs

where zs = 2 : concat (transpose [zs, map (*2) zs])

-- Definición de grafica_nImparesPascal

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

grafica_nImparesPascal :: Int -> IO ()

grafica_nImparesPascal n =

plotListStyle

[ Key Nothing

, PNG ("Impares_en_filas_del_triangulo_de_Pascal_" ++ show n ++ ".png")

]

(defaultStyle {plotType = LinesPoints})

(take n nImparesPascal3)

-- Propiedad de nImparesPascal

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

-- La propiedad es

prop_nImparesPascal :: Positive Int -> Bool

prop_nImparesPascal (Positive n) =

esPotenciaDeDos (nImparesPascal3 !! n)

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por

-- ejemplo,

-- esPotenciaDeDos 16 == True

-- esPotenciaDeDos 18 == False

esPotenciaDeDos :: Int -> Bool

esPotenciaDeDos 1 = True

esPotenciaDeDos n = even n && esPotenciaDeDos (n `div` 2)

-- La comprobación es

-- λ> quickCheck prop_nImparesPascal

-- +++ OK, passed 100 tests.

Pensamiento

De lo que llaman los hombres
virtud, justicia y bondad,
una mitad es envidia,
y la otra no es caridad.

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

Números con dígitos 1 y 2

PorJosé A. Alonso 28-enero-201926-marzo-2022

Definir las funciones

   numerosCon1y2               :: Int -> [Int]
   restosNumerosCon1y2         :: Int -> [Int]
   grafica_restosNumerosCon1y2 :: Int -> IO ()

numerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 :: Int -> [Int]

grafica_restosNumerosCon1y2 :: Int -> IO ()

tales que

(numerosCon1y2 n) es la lista ordenada de números de n dígitos que se pueden formar con los dígitos 1 y 2. Por ejemplo,

     numerosCon1y2 2  ==  [11,12,21,22] 
     numerosCon1y2 3  ==  [111,112,121,122,211,212,221,222]

1 2	numerosCon1y2 2 == [11,12,21,22] numerosCon1y2 3 == [111,112,121,122,211,212,221,222]

(restosNumerosCon1y2 n) es la lista de los restos de dividir los elementos de (restosNumerosCon1y2 n) entre 2^n. Por ejemplo,

     restosNumerosCon1y2 2 == [3,0,1,2]
     restosNumerosCon1y2 3 == [7,0,1,2,3,4,5,6]
     restosNumerosCon1y2 4 == [7,8,1,2,11,12,5,6,15,0,9,10,3,4,13,14]

restosNumerosCon1y2 2 == [3,0,1,2]

restosNumerosCon1y2 3 == [7,0,1,2,3,4,5,6]

restosNumerosCon1y2 4 == [7,8,1,2,11,12,5,6,15,0,9,10,3,4,13,14]

(graficaRestosNumerosCon1y2 n) dibuja la gráfica de los restos de dividir los elementos de (restosNumerosCon1y2 n) entre 2^n. Por ejemplo, (graficaRestosNumerosCon1y2 3) dibuja

(graficaRestosNumerosCon1y2 4) dibuja

y (graficaRestosNumerosCon1y2 5) dibuja

Nota: En la definición usar la función plotListStyle y como su segundo argumento (el PloStyle) usar

     (defaultStyle {plotType = LinesPoints,
                    lineSpec = CustomStyle [PointType 7]})

1 2	(defaultStyle {plotType = LinesPoints, lineSpec = CustomStyle [PointType 7]})

Comprobar con QuickCheck que todos los elementos de (restosNumerosCon1y2 n) son distintos.

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2
-- ===========================

numerosCon1y2 :: Int -> [Int]
numerosCon1y2 = map digitosAnumero . digitos

-- (dígitos n) es la lista ordenada de de listas de n elementos que
-- se pueden formar con los dígitos 1 y 2. Por ejemplo,
--    λ> digitos 2
--    [[1,1],[1,2],[2,1],[2,2]]
--    λ> digitos 3
--    [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2]]
digitos :: Int -> [[Int]]
digitos 0 = [[]]
digitos n = map (1:) xss ++ map (2:) xss
  where xss = digitos (n-1)

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,
--    digitosAnumero [2,0,1,9]  ==  2019
digitosAnumero :: [Int] -> Int
digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2
-- =================================

restosNumerosCon1y2 :: Int -> [Int]
restosNumerosCon1y2 n =
  [x `mod` m | x <- numerosCon1y2 n]
  where m = 2^n

-- Definición de graficaRestosNumerosCon1y2
-- =========================================

graficaRestosNumerosCon1y2 :: Int -> IO ()
graficaRestosNumerosCon1y2 n =
  plotListStyle
    [ Key Nothing
    , PNG ("Numeros_con_digitos_1_y_2_" ++ show n ++ ".png")
    ]
    (defaultStyle {plotType = LinesPoints,
                   lineSpec = CustomStyle [PointType 7]})
    (restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2
-- ================================

-- La propiedad
prop_restosNumerosCon1y2 :: Positive Int -> Bool
prop_restosNumerosCon1y2 (Positive n) =
  todosDistintos (restosNumerosCon1y2 n)
  where todosDistintos xs = xs == nub xs

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=12}) prop_restosNumerosCon1y2
--    +++ OK, passed 100 tests.

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2

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

numerosCon1y2 :: Int -> [Int]

numerosCon1y2 = map digitosAnumero . digitos

-- (dígitos n) es la lista ordenada de de listas de n elementos que

-- se pueden formar con los dígitos 1 y 2. Por ejemplo,

-- λ> digitos 2

-- [[1,1],[1,2],[2,1],[2,2]]

-- λ> digitos 3

-- [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2]]

digitos :: Int -> [[Int]]

digitos 0 = [[]]

digitos n = map (1:) xss ++ map (2:) xss

where xss = digitos (n-1)

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,

-- digitosAnumero [2,0,1,9] == 2019

digitosAnumero :: [Int] -> Int

digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2

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

restosNumerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 n =

[x `mod` m | x <- numerosCon1y2 n]

where m = 2^n

-- Definición de graficaRestosNumerosCon1y2

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

graficaRestosNumerosCon1y2 :: Int -> IO ()

graficaRestosNumerosCon1y2 n =

plotListStyle

[ Key Nothing

, PNG ("Numeros_con_digitos_1_y_2_" ++ show n ++ ".png")

]

(defaultStyle {plotType = LinesPoints,

lineSpec = CustomStyle [PointType 7]})

(restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2

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

-- La propiedad

prop_restosNumerosCon1y2 :: Positive Int -> Bool

prop_restosNumerosCon1y2 (Positive n) =

todosDistintos (restosNumerosCon1y2 n)

where todosDistintos xs = xs == nub xs

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=12}) prop_restosNumerosCon1y2

-- +++ OK, passed 100 tests.

Pensamiento

¿Para qué llamar caminos
a los surcos del azar? …
Todo el que camina anda,
como Jesús, sobre el mar.

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

Meses: enero 2019

Triángulo de Pascal binario

Soluciones

Pensamiento

Impares en filas del triángulo de Pascal

Soluciones

Pensamiento

Árboles con n elementos

Soluciones

Pensamiento

Números con dígitos 1 y 2

Soluciones

Pensamiento

Recorrido de árboles en espiral

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico