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

Números primos en pi

PorJosé A. Alonso 24-enero-201931-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 las funciones

   nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]
   graficaPrimosEnPi      :: Int -> Int -> IO ()

1 2	nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int] graficaPrimosEnPi :: Int -> Int -> IO ()

tales que

(nOcurrenciasPrimosEnPi n k) es la lista de longitud n cuyo i-ésimo elemento es el número de ocurrencias del i-ésimo número primo en los k primeros decimales del número pi. Por ejemplo,

   nOcurrenciasPrimosEnPi 4 20 == [2,3,3,1]

1	nOcurrenciasPrimosEnPi 4 20 == [2,3,3,1]

ya que los 20 primeros decimales de pi son 14159265358979323846 y en ellos ocurre el 2 dos veces, el 3 ocurre 3 veces, el 5 ocurre 3 veces y el 7 ocurre 1 vez. Otros ejemplos son

     λ> nOcurrenciasPrimosEnPi 10 100
     [12,11,8,8,1,0,1,1,2,0]
     λ> nOcurrenciasPrimosEnPi 10 (10^4)
     [1021,974,1046,970,99,102,90,113,99,95]
     λ> nOcurrenciasPrimosEnPi 10 (10^6)
     [100026,100229,100359,99800,10064,10012,9944,10148,9951,9912]

λ> nOcurrenciasPrimosEnPi 10 100

[12,11,8,8,1,0,1,1,2,0]

λ> nOcurrenciasPrimosEnPi 10 (10^4)

[1021,974,1046,970,99,102,90,113,99,95]

λ> nOcurrenciasPrimosEnPi 10 (10^6)

[100026,100229,100359,99800,10064,10012,9944,10148,9951,9912]

(graficaPrimosEnPi n k) dibuja la gráfica del número de ocurrencias de los n primeros números primos en los k primeros dígitos de pi. Por ejemplo, (graficaPrimosEnPi 10 (10^4)) dibuja

(graficaPrimosEnPi 10 (10^6)) dibuja

y (graficaPrimosEnPi 50 (10^5)) dibuja

Soluciones

import Data.List               ( isPrefixOf
                               , findIndices
                               , tails )
import Data.Numbers.Primes     ( primes)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de nOcurrenciasPrimosEnPi
-- ====================================

nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]
nOcurrenciasPrimosEnPi n k = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  let ps = take n primes
  let es = take k ds
  return [nOcurrencias (show x) es | x <- ps]

-- (nOcurrencias xs yss) es el número de ocurrencias de xs en yss. Por
-- ejemplo,
--    nOcurrencias "ac" "acbadcacaac"  ==  3
nOcurrencias :: Eq a => [a] -> [a] -> Int
nOcurrencias xs yss = length (ocurrencias xs yss)

-- (ocurrencias xs yss) es el índice de las posiciones del primer
-- elemento de xs en las ocurrencias de xs en yss. Por ejemplo,
--    ocurrencias "ac" "acbadcacaac"  ==  [0,6,9]
ocurrencias :: Eq a => [a] -> [a] -> [Int]
ocurrencias xs yss =
  findIndices (xs `isPrefixOf`) (tails yss)

-- Definición de graficaPrimosEnPi
-- ===============================

graficaPrimosEnPi :: Int -> Int -> IO ()
graficaPrimosEnPi n k = do
  xs <- nOcurrenciasPrimosEnPi n k
  plotList [ Key Nothing
           , PNG ("Numeros_primos_en_pi_" ++ show (n,k) ++ ".png")  
           ]
           xs

import Data.List ( isPrefixOf

, findIndices

, tails )

import Data.Numbers.Primes ( primes)

import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)

, plotList )

-- Definición de nOcurrenciasPrimosEnPi

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

nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]

nOcurrenciasPrimosEnPi n k = do

(_:_:ds) <- readFile "Digitos_de_pi.txt"

let ps = take n primes

let es = take k ds

return [nOcurrencias (show x) es | x <- ps]

-- (nOcurrencias xs yss) es el número de ocurrencias de xs en yss. Por

-- ejemplo,

-- nOcurrencias "ac" "acbadcacaac" == 3

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

nOcurrencias xs yss = length (ocurrencias xs yss)

-- (ocurrencias xs yss) es el índice de las posiciones del primer

-- elemento de xs en las ocurrencias de xs en yss. Por ejemplo,

-- ocurrencias "ac" "acbadcacaac" == [0,6,9]

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

ocurrencias xs yss =

findIndices (xs `isPrefixOf`) (tails yss)

-- Definición de graficaPrimosEnPi

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

graficaPrimosEnPi :: Int -> Int -> IO ()

graficaPrimosEnPi n k = do

xs <- nOcurrenciasPrimosEnPi n k

plotList [ Key Nothing

, PNG ("Numeros_primos_en_pi_" ++ show (n,k) ++ ".png")

]

Pensamiento

Al borde del sendero un día nos sentamos.
Ya nuestra vida es tiempo, y nuestra sola cuita
son las desesperantes posturas que tomamos
para aguardar … Mas ella no faltará a la cita.

Antonio Machado

Sucesión triangular

PorJosé A. Alonso 23-enero-201930-enero-2019

La sucesión triangular es la obtenida concatenando las listas [1], [1,2], [1,2,3], [1,2,3,4], …. Sus primeros términos son 1, 1, 2, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, …

Definir las funciones

   sucTriangular        :: [Integer]
   terminoSucTriangular :: Int -> Integer
   graficaSucTriangular :: Int -> IO ()

sucTriangular :: [Integer]

terminoSucTriangular :: Int -> Integer

graficaSucTriangular :: Int -> IO ()

tales que

sucTriangular es la lista de los términos de la sucesión triangular. Por ejemplo,

     λ> take 30 sucTriangular
     [1,1,2,1,2,3,1,2,3,4,1,2,3,4,5,1,2,3,4,5,6,1,2,3,4,5,6,7,1,2]

1 2	λ> take 30 sucTriangular [1,1,2,1,2,3,1,2,3,4,1,2,3,4,5,1,2,3,4,5,6,1,2,3,4,5,6,7,1,2]

(terminoSucTriangular n) es el término n-ésimo de la sucesión triangular. Por ejemplo,

     terminoSucTriangular 5       ==  3
     terminoSucTriangular 10      ==  1
     terminoSucTriangular 20      ==  6
     terminoSucTriangular 100     ==  10
     terminoSucTriangular 1001    ==  12
     terminoSucTriangular (10^5)  ==  320

terminoSucTriangular 5 == 3

terminoSucTriangular 10 == 1

terminoSucTriangular 20 == 6

terminoSucTriangular 100 == 10

terminoSucTriangular 1001 == 12

terminoSucTriangular (10^5) == 320

(graficaSucTriangular n) dibuja la gráfica de los n primeros términos de la sucesión triangular. Por ejemplo, (graficaSucTriangular 300) dibuja

Soluciones

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

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

sucTriangular :: [Integer]
sucTriangular =
  concat [[1..n] | n <- [1..]]

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

sucTriangular2 :: [Integer]
sucTriangular2 =
  [x | n <- [1..], x <- [1..n]]

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

sucTriangular3 :: [Integer]
sucTriangular3 =
  concat (tail (inits [1..]))
  
-- 1ª definición de terminoSucTriangular
-- =====================================

terminoSucTriangular :: Int -> Integer
terminoSucTriangular k =
  sucTriangular !! k

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

terminoSucTriangular2 :: Int -> Integer
terminoSucTriangular2 k =
  sucTriangular2 !! k

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

terminoSucTriangular3 :: Int -> Integer
terminoSucTriangular3 k =
  sucTriangular3 !! k

-- Equivalencia de definiciones
-- ============================

-- La propiedad es
prop_terminoTriangular :: Positive Int -> Bool
prop_terminoTriangular (Positive n) =
  terminoSucTriangular n == terminoSucTriangular2 n &&
  terminoSucTriangular n == terminoSucTriangular3 n

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

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

--    λ> terminoSucTriangular (3*10^6)
--    2425
--    (2.07 secs, 384,707,936 bytes)
--    λ> terminoSucTriangular2 (3*10^6)
--    2425
--    (2.22 secs, 432,571,208 bytes)
--    λ> terminoSucTriangular3 (3*10^6)
--    2425
--    (0.69 secs, 311,259,504 bytes)

-- Definición de graficaSucTriangular
-- ==================================

graficaSucTriangular :: Int -> IO ()
graficaSucTriangular n =
  plotList [ Key Nothing
           , PNG "Sucesion_triangular.png"
           ]
           (take n sucTriangular)

import Data.List (inits)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de sucTriangular

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

sucTriangular :: [Integer]

sucTriangular =

concat [[1..n] | n <- [1..]]

-- 2ª definición de sucTriangular

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

sucTriangular2 :: [Integer]

sucTriangular2 =

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

-- 3ª definición de sucTriangular

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

sucTriangular3 :: [Integer]

sucTriangular3 =

concat (tail (inits [1..]))

-- 1ª definición de terminoSucTriangular

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

terminoSucTriangular :: Int -> Integer

terminoSucTriangular k =

sucTriangular !! k

-- 2ª definición de terminoSucTriangular

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

terminoSucTriangular2 :: Int -> Integer

terminoSucTriangular2 k =

sucTriangular2 !! k

-- 3ª definición de terminoSucTriangular

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

terminoSucTriangular3 :: Int -> Integer

terminoSucTriangular3 k =

sucTriangular3 !! k

-- Equivalencia de definiciones

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

-- La propiedad es

prop_terminoTriangular :: Positive Int -> Bool

prop_terminoTriangular (Positive n) =

terminoSucTriangular n == terminoSucTriangular2 n &&

terminoSucTriangular n == terminoSucTriangular3 n

-- La comprobación es

-- λ> quickCheck prop_terminoTriangular

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> terminoSucTriangular (3*10^6)

-- 2425

-- (2.07 secs, 384,707,936 bytes)

-- λ> terminoSucTriangular2 (3*10^6)

-- 2425

-- (2.22 secs, 432,571,208 bytes)

-- λ> terminoSucTriangular3 (3*10^6)

-- 2425

-- (0.69 secs, 311,259,504 bytes)

-- Definición de graficaSucTriangular

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

graficaSucTriangular :: Int -> IO ()

graficaSucTriangular n =

plotList [ Key Nothing

, PNG "Sucesion_triangular.png"

]

(take n sucTriangular)

Pensamiento

Nadie debe asustarse de lo que piensa, aunque su pensar aparezca en pugna con las leyes más elementales de la lógica. Porque todo ha de ser pensado por alguien, y el mayor desatino puede ser un punto de vista de lo real.

Antonio Machado

Soluciones de x² = y³ = k

PorJosé A. Alonso 22-enero-201929-enero-2019

Definir la función

   soluciones :: [(Integer,Integer,Integer)]

1	soluciones :: [(Integer,Integer,Integer)]

tal que sus elementos son las ternas (x,y,k) de soluciones del sistema x² = y³ = k. Por ejemplo,

   λ> take 6 soluciones
   [(0,0,0),(-1,1,1),(1,1,1),(-8,4,64),(8,4,64),(-27,9,729)]
   λ> soluciones !! (6*10^5+6) 
   (27000810008100027,90001800009,729043741093514580109350437400729)

λ> take 6 soluciones

[(0,0,0),(-1,1,1),(1,1,1),(-8,4,64),(8,4,64),(-27,9,729)]

λ> soluciones !! (6*10^5+6)

(27000810008100027,90001800009,729043741093514580109350437400729)

Soluciones

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

soluciones :: [(Integer,Integer,Integer)]
soluciones = [(n^3, n^2, n^6) | n <- enteros]

-- enteros es la lista ordenada de los números enteros. Por ejemplo,
--    λ> take 20 enteros
--    [0,-1,1,-2,2,-3,3,-4,4,-5,5,-6,6,-7,7,-8,8,-9,9,-10]
enteros :: [Integer]
enteros = 0 : concat [[-x,x] | x <- [1..]]

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

soluciones2 :: [(Integer,Integer,Integer)]
soluciones2 = [(x^3,x^2,x^6) | x <- 0 : aux 1]
  where aux n  = -n : n : aux (n+1)

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

soluciones3 :: [(Integer,Integer,Integer)]
soluciones3 =
  (0,0,0) : [(x,y,k) | k <- [n^6 | n <- [1..]]  
                     , let Just x' = raiz 2 k
                     , let Just y  = raiz 3 k
                     , x <- [-x',x']]

-- (raiz n x) es es justo la raíz n-ésima del número natural x, si x es
-- una potencia n-ésima y Nothing en caso contrario. Por ejemplo,
--    raiz 2 16   ==  Just 4
--    raiz 3 216  ==  Just 6
--    raiz 5 216  ==  Nothing
raiz :: Int -> Integer -> Maybe Integer 
raiz _ 1 = Just 1
raiz n 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^n

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

--    λ> soluciones !! (6*10^5+6)
--    (27000810008100027,90001800009,729043741093514580109350437400729)
--    (1.87 secs, 247,352,728 bytes)
--    λ> soluciones2 !! (6*10^5+6)
--    (27000810008100027,90001800009,729043741093514580109350437400729)
--    (1.44 secs, 243,012,936 bytes)
--    λ> soluciones3 !! (6*10^5+6)
--    (27000810008100027,90001800009,729043741093514580109350437400729)
--    (0.84 secs, 199,599,664 bytes)

-- 1ª solución

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

soluciones :: [(Integer,Integer,Integer)]

soluciones = [(n^3, n^2, n^6) | n <- enteros]

-- enteros es la lista ordenada de los números enteros. Por ejemplo,

-- λ> take 20 enteros

-- [0,-1,1,-2,2,-3,3,-4,4,-5,5,-6,6,-7,7,-8,8,-9,9,-10]

enteros :: [Integer]

enteros = 0 : concat [[-x,x] | x <- [1..]]

-- 2ª solución

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

soluciones2 :: [(Integer,Integer,Integer)]

soluciones2 = [(x^3,x^2,x^6) | x <- 0 : aux 1]

where aux n = -n : n : aux (n+1)

-- 3ª solución

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

soluciones3 :: [(Integer,Integer,Integer)]

soluciones3 =

(0,0,0) : [(x,y,k) | k <- [n^6 | n <- [1..]]

, let Just x' = raiz 2 k

, let Just y = raiz 3 k

, x <- [-x',x']]

-- (raiz n x) es es justo la raíz n-ésima del número natural x, si x es

-- una potencia n-ésima y Nothing en caso contrario. Por ejemplo,

-- raiz 2 16 == Just 4

-- raiz 3 216 == Just 6

-- raiz 5 216 == Nothing

raiz :: Int -> Integer -> Maybe Integer

raiz _ 1 = Just 1

raiz n 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^n

-- Comparación de eficiencia

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

-- λ> soluciones !! (6*10^5+6)

-- (27000810008100027,90001800009,729043741093514580109350437400729)

-- (1.87 secs, 247,352,728 bytes)

-- λ> soluciones2 !! (6*10^5+6)

-- (27000810008100027,90001800009,729043741093514580109350437400729)

-- (1.44 secs, 243,012,936 bytes)

-- λ> soluciones3 !! (6*10^5+6)

-- (27000810008100027,90001800009,729043741093514580109350437400729)

-- (0.84 secs, 199,599,664 bytes)

Pensamiento

Leyendo a Cervantes me parece comprenderlo todo.

Antonio Machado

Intersección de listas infinitas crecientes

PorJosé A. Alonso 21-enero-201925-abril-2021

Definir la función

   interseccion :: Ord a => [[a]] -> [a]

1	interseccion :: Ord a => [[a]] -> [a]

tal que (interseccion xss) es la intersección de la lista no vacía de listas infinitas crecientes xss; es decir, la lista de los elementos que pertenecen a todas las listas de xss. Por ejemplo,

   λ> take 10 (interseccion [[2,4..],[3,6..],[5,10..]])
   [30,60,90,120,150,180,210,240,270,300]
   λ> take 10 (interseccion [[2,5..],[3,5..],[5,7..]])
   [5,11,17,23,29,35,41,47,53,59]

λ> take 10 (interseccion [[2,4..],[3,6..],[5,10..]])

[30,60,90,120,150,180,210,240,270,300]

λ> take 10 (interseccion [[2,5..],[3,5..],[5,7..]])

[5,11,17,23,29,35,41,47,53,59]

Soluciones

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

interseccion :: Ord a => [[a]] -> [a]
interseccion [xs]        = xs
interseccion (xs:ys:zss) = interseccionDos xs (interseccion (ys:zss))

interseccionDos :: Ord a => [a] -> [a] -> [a]
interseccionDos (x:xs) (y:ys)
  | x == y    = x : interseccionDos xs ys
  | x < y     = interseccionDos (dropWhile (<y) xs) (y:ys)
  | otherwise = interseccionDos (x:xs) (dropWhile (<x) ys)  

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

interseccion2 :: Ord a => [[a]] -> [a]
interseccion2 = foldl1 interseccionDos

-- 1ª solución

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

interseccion :: Ord a => [[a]] -> [a]

interseccion [xs] = xs

interseccion (xs:ys:zss) = interseccionDos xs (interseccion (ys:zss))

interseccionDos :: Ord a => [a] -> [a] -> [a]

interseccionDos (x:xs) (y:ys)

| x == y = x : interseccionDos xs ys

| x < y = interseccionDos (dropWhile (<y) xs) (y:ys)

| otherwise = interseccionDos (x:xs) (dropWhile (<x) ys)

-- 2ª solución

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

interseccion2 :: Ord a => [[a]] -> [a]

interseccion2 = foldl1 interseccionDos

Pensamiento

Alguna vez he pensado
si el alma será la ausencia,
mientras más cerca más lejos;
mientras más lejos más cerca.

Antonio Machado

Mínimo número de operaciones para transformar un número en otro

PorJosé A. Alonso 18-enero-201925-marzo-2022

Se considera el siguiente par de operaciones sobre los números:

multiplicar por dos
restar uno.

Dados dos números x e y se desea calcular el menor número de operaciones para transformar x en y. Por ejemplo, el menor número de operaciones para transformar el 4 en 7 es 2:

   4 ------> 8 ------> 7
      (*2)      (-1)

1 2	4 ------> 8 ------> 7 (*2) (-1)

y el menor número de operaciones para transformar 2 en 5 es 4

   2 ------> 4 ------> 3 ------> 6 ------> 5
      (*2)      (-1)      (*2)      (-1)

1 2	2 ------> 4 ------> 3 ------> 6 ------> 5 (2) (-1) (2) (-1)

Definir las siguientes funciones

   arbolOp :: Int -> Int -> Arbol
   minNOp  :: Int -> Int -> Int

1 2	arbolOp :: Int -> Int -> Arbol minNOp :: Int -> Int -> Int

tales que

(arbolOp x n) es el árbol de profundidad n obtenido aplicándole a x las dos operaciones. Por ejemplo,

    λ> arbolOp 4 1
    N 4 (H 8) (H 3)
    λ> arbolOp 4 2
    N 4 (N 8 (H 16) (H 7))
        (N 3 (H 6) (H 2))
    λ> arbolOp 2 3
    N 2 (N 4
           (N 8 (H 16) (H 7))
           (N 3 (H 6) (H 2)))
        (N 1
           (N 2 (H 4) (H 1))
           (H 0))
    λ> arbolOp 2 4
    N 2 (N 4 (N 8
                (N 16 (H 32) (H 15))
                (N 7 (H 14) (H 6)))
             (N 3
                (N 6 (H 12) (H 5))
                (N 2 (H 4) (H 1))))
        (N 1 (N 2
                (N 4 (H 8) (H 3))
                (N 1 (H 2) (H 0)))
             (H 0))

λ> arbolOp 4 1

N 4 (H 8) (H 3)

λ> arbolOp 4 2

N 4 (N 8 (H 16) (H 7))

(N 3 (H 6) (H 2))

λ> arbolOp 2 3

N 2 (N 4

(N 8 (H 16) (H 7))

(N 3 (H 6) (H 2)))

(N 1

(N 2 (H 4) (H 1))

(H 0))

λ> arbolOp 2 4

N 2 (N 4 (N 8

(N 16 (H 32) (H 15))

(N 7 (H 14) (H 6)))

(N 3

(N 6 (H 12) (H 5))

(N 2 (H 4) (H 1))))

(N 1 (N 2

(N 4 (H 8) (H 3))

(N 1 (H 2) (H 0)))

(H 0))

(minNOp x y) es el menor número de operaciones necesarias para transformar x en y. Por ejemplo,

     minNOp 4 7  ==  2
     minNOp 2 5  ==  4

1 2	minNOp 4 7 == 2 minNOp 2 5 == 4

Soluciones

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

arbolOp :: Int -> Int -> Arbol
arbolOp 0 _ = H 0
arbolOp x 0 = H x
arbolOp x n = N x (arbolOp (2 * x) (n - 1)) (arbolOp (x - 1) (n - 1))

ocurre :: Int -> Arbol -> Bool
ocurre x (H y)     = x == y
ocurre x (N y i d) = x == y || ocurre x i || ocurre x d

minNOp :: Int -> Int -> Int
minNOp x y =
  head [n | n <- [0..]
          , ocurre y (arbolOp x n)]

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

arbolOp :: Int -> Int -> Arbol

arbolOp 0 _ = H 0

arbolOp x 0 = H x

arbolOp x n = N x (arbolOp (2 * x) (n - 1)) (arbolOp (x - 1) (n - 1))

ocurre :: Int -> Arbol -> Bool

ocurre x (H y) = x == y

ocurre x (N y i d) = x == y || ocurre x i || ocurre x d

minNOp :: Int -> Int -> Int

minNOp x y =

head [n | n <- [0..]

, ocurre y (arbolOp x n)]

Pensamiento

¿Dijiste media verdad?
Dirán que mientes dos veces
si dices la otra mitad.

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

Números altamente compuestos

PorJosé A. Alonso 16-enero-201923-enero-2019

Un número altamente compuesto es un entero positivo con más divisores que cualquier entero positivo más pequeño. Por ejemplo,

4 es un número altamente compuesto porque es el menor con 3 divisores,
5 no es altamente compuesto porque tiene menos divisores que 4 y
6 es un número altamente compuesto porque es el menor con 4 divisores,

Los primeros números altamente compuestos son

   1, 2, 4, 6, 12, 24, 36, 48, 60, 120, 180, 240, 360, ...

1	1, 2, 4, 6, 12, 24, 36, 48, 60, 120, 180, 240, 360, ...

Definir las funciones

   esAltamenteCompuesto       :: Int -> Bool
   altamenteCompuestos        :: [Int]
   graficaAltamenteCompuestos :: Int -> IO ()

esAltamenteCompuesto :: Int -> Bool

altamenteCompuestos :: [Int]

graficaAltamenteCompuestos :: Int -> IO ()

tales que

(esAltamanteCompuesto x) se verifica si x es altamente compuesto. Por ejemplo,

     esAltamenteCompuesto 4      ==  True
     esAltamenteCompuesto 5      ==  False
     esAltamenteCompuesto 6      ==  True
     esAltamenteCompuesto 1260   ==  True
     esAltamenteCompuesto 2520   ==  True
     esAltamenteCompuesto 27720  ==  True

esAltamenteCompuesto 4 == True

esAltamenteCompuesto 5 == False

esAltamenteCompuesto 6 == True

esAltamenteCompuesto 1260 == True

esAltamenteCompuesto 2520 == True

esAltamenteCompuesto 27720 == True

altamente compuestos es la sucesión de los números altamente compuestos. Por ejemplo,

     λ> take 20 altamenteCompuestos
     [1,2,4,6,12,24,36,48,60,120,180,240,360,720,840,1260,1680,2520,5040,7560]

1 2	λ> take 20 altamenteCompuestos [1,2,4,6,12,24,36,48,60,120,180,240,360,720,840,1260,1680,2520,5040,7560]

(graficaAltamenteCompuestos n) dibuja la gráfica de los n primeros números altamente compuestos. Por ejemplo, (graficaAltamenteCompuestos 25) dibuja

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

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

esAltamenteCompuesto :: Int -> Bool
esAltamenteCompuesto x =
  and [nDivisores x > nDivisores y | y <- [1..x-1]]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 30  ==  8
nDivisores :: Int -> Int
nDivisores x = length (divisores x)

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Int -> [Int]
divisores x =
  [y | y <- [1..x]
     , x `mod` y == 0]

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

esAltamenteCompuesto2 :: Int -> Bool
esAltamenteCompuesto2 x =
  all (nDivisores2 x >) [nDivisores2 y | y <- [1..x-1]]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,
--    nDivisores2 30  ==  8
nDivisores2 :: Int -> Int
nDivisores2 = succ . length . divisoresPropios

-- (divisoresPropios x) es la lista de los divisores de x menores que
-- x. Por ejemplo, 
--    divisoresPropios 30  ==  [1,2,3,5,6,10,15]
divisoresPropios :: Int -> [Int]
divisoresPropios x =
  [y | y <- [1..x `div` 2]
     , x `mod` y == 0]

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

esAltamenteCompuesto3 :: Int -> Bool
esAltamenteCompuesto3 x =
  all (nDivisores3 x >) [nDivisores3 y | y <- [1..x-1]]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,
--    nDivisores3 30  ==  8
nDivisores3 :: Int -> Int
nDivisores3 x =
  product [1 + length xs | xs <- group (primeFactors x)]

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

esAltamenteCompuesto4 :: Int -> Bool
esAltamenteCompuesto4 x =
  x `pertenece` altamenteCompuestos2

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

altamenteCompuestos :: [Int]
altamenteCompuestos =
  filter esAltamenteCompuesto4 [1..]

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

altamenteCompuestos2 :: [Int]
altamenteCompuestos2 =
  1 : [y | ((x,n),(y,m)) <- zip sucMaxDivisores (tail sucMaxDivisores)
         , m > n]

-- sucMaxDivisores es la sucesión formada por los números enteros
-- positivos y el máximo número de divisores hasta cada número. Por
-- ejemplo,
--    λ> take 12 sucMaxDivisores
--    [(1,1),(2,2),(3,2),(4,3),(5,3),(6,4),(7,4),(8,4),(9,4),(10,4),(11,4),(12,6)]
sucMaxDivisores :: [(Int,Int)]
sucMaxDivisores =
  zip [1..] (scanl1 max (map nDivisores3 [1..]))

pertenece :: Int -> [Int] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

--    λ> esAltamenteCompuesto 1260
--    True
--    (2.99 secs, 499,820,296 bytes)
--    λ> esAltamenteCompuesto2 1260
--    True
--    (0.51 secs, 83,902,744 bytes)
--    λ> esAltamenteCompuesto3 1260
--    True
--    (0.04 secs, 15,294,192 bytes)
--    λ> esAltamenteCompuesto4 1260
--    True
--    (0.04 secs, 15,594,392 bytes)
--    
--    λ> esAltamenteCompuesto2 2520
--    True
--    (2.10 secs, 332,940,168 bytes)
--    λ> esAltamenteCompuesto3 2520
--    True
--    (0.09 secs, 37,896,168 bytes)
--    λ> esAltamenteCompuesto4 2520
--    True
--    (0.06 secs, 23,087,456 bytes)
--
--    λ> esAltamenteCompuesto3 27720
--    True
--    (1.32 secs, 841,010,624 bytes)
--    λ> esAltamenteCompuesto4 27720
--    True
--    (1.33 secs, 810,870,384 bytes)

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

--    λ> altamenteCompuestos !! 25
--    45360
--    (2.84 secs, 1,612,045,976 bytes)
--    λ> altamenteCompuestos2 !! 25
--    45360
--    (0.01 secs, 102,176 bytes)

-- Definición de graficaAltamenteCompuestos
-- ========================================

graficaAltamenteCompuestos :: Int -> IO ()
graficaAltamenteCompuestos n =
  plotList [ Key Nothing
           , PNG ("Numeros_altamente_compuestos.png")
           ]
           (take n altamenteCompuestos2)

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

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto :: Int -> Bool

esAltamenteCompuesto x =

and [nDivisores x > nDivisores y | y <- [1..x-1]]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 30 == 8

nDivisores :: Int -> Int

nDivisores x = length (divisores x)

-- (divisores x) es la lista de los divisores de x. Por ejemplo,

-- divisores 30 == [1,2,3,5,6,10,15,30]

divisores :: Int -> [Int]

divisores x =

[y | y <- [1..x]

, x `mod` y == 0]

-- 2ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto2 :: Int -> Bool

esAltamenteCompuesto2 x =

all (nDivisores2 x >) [nDivisores2 y | y <- [1..x-1]]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,

-- nDivisores2 30 == 8

nDivisores2 :: Int -> Int

nDivisores2 = succ . length . divisoresPropios

-- (divisoresPropios x) es la lista de los divisores de x menores que

-- x. Por ejemplo,

-- divisoresPropios 30 == [1,2,3,5,6,10,15]

divisoresPropios :: Int -> [Int]

divisoresPropios x =

[y | y <- [1..x `div` 2]

, x `mod` y == 0]

-- 3ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto3 :: Int -> Bool

esAltamenteCompuesto3 x =

all (nDivisores3 x >) [nDivisores3 y | y <- [1..x-1]]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,

-- nDivisores3 30 == 8

nDivisores3 :: Int -> Int

nDivisores3 x =

product [1 + length xs | xs <- group (primeFactors x)]

-- 4ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto4 :: Int -> Bool

esAltamenteCompuesto4 x =

x `pertenece` altamenteCompuestos2

-- 1ª definición de altamenteCompuestos

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

altamenteCompuestos :: [Int]

altamenteCompuestos =

filter esAltamenteCompuesto4 [1..]

-- 2ª definición de altamenteCompuestos

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

altamenteCompuestos2 :: [Int]

altamenteCompuestos2 =

1 : [y | ((x,n),(y,m)) <- zip sucMaxDivisores (tail sucMaxDivisores)

, m > n]

-- sucMaxDivisores es la sucesión formada por los números enteros

-- positivos y el máximo número de divisores hasta cada número. Por

-- ejemplo,

-- λ> take 12 sucMaxDivisores

-- [(1,1),(2,2),(3,2),(4,3),(5,3),(6,4),(7,4),(8,4),(9,4),(10,4),(11,4),(12,6)]

sucMaxDivisores :: [(Int,Int)]

sucMaxDivisores =

zip [1..] (scanl1 max (map nDivisores3 [1..]))

pertenece :: Int -> [Int] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- Comparación de eficiencia de esAltamenteCompuesto

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

-- λ> esAltamenteCompuesto 1260

-- True

-- (2.99 secs, 499,820,296 bytes)

-- λ> esAltamenteCompuesto2 1260

-- True

-- (0.51 secs, 83,902,744 bytes)

-- λ> esAltamenteCompuesto3 1260

-- True

-- (0.04 secs, 15,294,192 bytes)

-- λ> esAltamenteCompuesto4 1260

-- True

-- (0.04 secs, 15,594,392 bytes)

-- λ> esAltamenteCompuesto2 2520

-- True

-- (2.10 secs, 332,940,168 bytes)

-- λ> esAltamenteCompuesto3 2520

-- True

-- (0.09 secs, 37,896,168 bytes)

-- λ> esAltamenteCompuesto4 2520

-- True

-- (0.06 secs, 23,087,456 bytes)

-- λ> esAltamenteCompuesto3 27720

-- True

-- (1.32 secs, 841,010,624 bytes)

-- λ> esAltamenteCompuesto4 27720

-- True

-- (1.33 secs, 810,870,384 bytes)

-- Comparación de eficiencia de altamenteCompuestos

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

-- λ> altamenteCompuestos !! 25

-- 45360

-- (2.84 secs, 1,612,045,976 bytes)

-- λ> altamenteCompuestos2 !! 25

-- 45360

-- (0.01 secs, 102,176 bytes)

-- Definición de graficaAltamenteCompuestos

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

graficaAltamenteCompuestos :: Int -> IO ()

graficaAltamenteCompuestos n =

plotList [ Key Nothing

, PNG ("Numeros_altamente_compuestos.png")

]

(take n altamenteCompuestos2)

Pensamiento

Nuestras horas son minutos
cuando esperamos saber,
y siglos cuando sabemos
lo que se puede aprender.

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

Ofertas 3 por 2

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

En una tienda tiene la «oferta 3 por 2» de forma que cada cliente que elige 3 artículos obtiene el más barato de forma gratuita. Por ejemplo, si los precios de los artículos elegidos por un cliente son 10, 2, 4, 5 euros pagará 19 euros si agrupa los artículos en (10,2,4) y (5) o pagará 17 si lo agupa en (5,10,4) y (2).

Definir la función

   minimoConOferta :: [Int] -> Int

1	minimoConOferta :: [Int] -> Int

tal que (minimoConOferta xs) es lo mínimo que pagará el cliente si los precios de la compra son xs; es decir, lo que pagará agrupando los artículos de forma óptima para aplicar la oferta 3 por 2. Por ejemplo,

   minimoConOferta [10,2,4,5]     ==  17
   minimoConOferta [3,2,3,2]      ==  8
   minimoConOferta [6,4,5,5,5,5]  ==  21

minimoConOferta [10,2,4,5] == 17

minimoConOferta [3,2,3,2] == 8

minimoConOferta [6,4,5,5,5,5] == 21

Soluciones

import Data.List ( sort
                 , sortOn)
import Data.Ord  ( Down(..))

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

minimoConOferta :: [Int] -> Int
minimoConOferta xs = sum (sinTerceros (reverse (sort xs)))

sinTerceros :: [a] -> [a]
sinTerceros []         = []
sinTerceros [x]        = [x]
sinTerceros [x,y]      = [x,y]
sinTerceros (x:y:_:zs) = x : y : sinTerceros zs

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

minimoConOferta2 :: [Int] -> Int
minimoConOferta2 = sum . sinTerceros . reverse . sort

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

minimoConOferta3 :: [Int] -> Int
minimoConOferta3 = sum . sinTerceros . sortOn Down

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

minimoConOferta4 :: [Int] -> Int
minimoConOferta4 xs = aux (reverse (sort xs)) 0
  where aux (a:b:_:ds) n = aux ds (a+b+n)
        aux as         n = n + sum as 

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

minimoConOferta5 :: [Int] -> Int
minimoConOferta5 xs = aux (sortOn Down xs) 0
  where aux (a:b:_:ds) n = aux ds (a+b+n)
        aux as         n = n + sum as

import Data.List ( sort

, sortOn)

import Data.Ord ( Down(..))

-- 1ª solución

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

minimoConOferta :: [Int] -> Int

minimoConOferta xs = sum (sinTerceros (reverse (sort xs)))

sinTerceros :: [a] -> [a]

sinTerceros [] = []

sinTerceros [x] = [x]

sinTerceros [x,y] = [x,y]

sinTerceros (x:y:_:zs) = x : y : sinTerceros zs

-- 2ª solución

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

minimoConOferta2 :: [Int] -> Int

minimoConOferta2 = sum . sinTerceros . reverse . sort

-- 3ª solución

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

minimoConOferta3 :: [Int] -> Int

minimoConOferta3 = sum . sinTerceros . sortOn Down

-- 4ª solución

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

minimoConOferta4 :: [Int] -> Int

minimoConOferta4 xs = aux (reverse (sort xs)) 0

where aux (a:b:_:ds) n = aux ds (a+b+n)

aux as n = n + sum as

-- 5ª solución

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

minimoConOferta5 :: [Int] -> Int

minimoConOferta5 xs = aux (sortOn Down xs) 0

where aux (a:b:_:ds) n = aux ds (a+b+n)

aux as n = n + sum as

Pensamiento

Despacito y buena letra:
el hacer las cosas bien
importa más que el hacerlas.

Antonio Machado

Mayor prefijo con suma acotada

PorJosé A. Alonso 11-enero-201918-enero-2019

Definir la función

   mayorPrefijoAcotado :: [Int] -> Int -> [Int]

1	mayorPrefijoAcotado :: [Int] -> Int -> [Int]

tal que (mayorPrefijoAcotado xs y) es el mayor prefijo de la lista de los números enteros positivos xs cuya suma es menor o igual que y. Por ejemplo,

   mayorPrefijoAcotado [45,30,55,20,80,20] 75   ==  [45,30]
   mayorPrefijoAcotado [45,30,55,20,80,20] 140  ==  [45,30,55]
   mayorPrefijoAcotado [45,30,55,20,80,20] 180  ==  [45,30,55,20]
   length (mayorPrefijoAcotado (repeat 1) (8*10^6)) == 8000000

mayorPrefijoAcotado [45,30,55,20,80,20] 75 == [45,30]

mayorPrefijoAcotado [45,30,55,20,80,20] 140 == [45,30,55]

mayorPrefijoAcotado [45,30,55,20,80,20] 180 == [45,30,55,20]

length (mayorPrefijoAcotado (repeat 1) (8*10^6)) == 8000000

Soluciones

import Data.List (inits)

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

mayorPrefijoAcotado :: [Int] -> Int -> [Int]
mayorPrefijoAcotado [] _     = []
mayorPrefijoAcotado (x:xs) y
  | x > y     = []
  | otherwise = x : mayorPrefijoAcotado xs (y-x)

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

mayorPrefijoAcotado2 :: [Int] -> Int -> [Int]
mayorPrefijoAcotado2 xs y =
  take (longitudMayorPrefijoAcotado2 xs y) xs

longitudMayorPrefijoAcotado2 :: [Int] -> Int -> Int
longitudMayorPrefijoAcotado2 xs y =
  length (takeWhile (<=y) (map sum (inits xs))) - 1

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

mayorPrefijoAcotado3 :: [Int] -> Int -> [Int]
mayorPrefijoAcotado3 xs y =
  take (longitudMayorPrefijoAcotado3 xs y) xs

longitudMayorPrefijoAcotado3 :: [Int] -> Int -> Int
longitudMayorPrefijoAcotado3 xs y =
  length (takeWhile (<= y) (scanl1 (+) xs))

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

-- La propiedad es
prop_equiv :: [Int] -> Int -> Bool
prop_equiv xs y =
  mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado2 xs' y' &&
  mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado3 xs' y' 
  where xs' = map abs xs
        y'  = abs y

-- La comprobación es
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.
--    (0.01 secs, 2,463,688 bytes)

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

--    λ> length (mayorPrefijoAcotado (repeat 1) (2*10^4))
--    20000
--    (0.04 secs, 5,086,544 bytes)
--    λ> length (mayorPrefijoAcotado2 (repeat 1) (2*10^4))
--    20000
--    (11.22 secs, 27,083,980,168 bytes)
--    λ> length (mayorPrefijoAcotado3 (repeat 1) (2*10^4))
--    20000
--    (0.02 secs, 4,768,992 bytes)
--    
--    λ> length (mayorPrefijoAcotado (repeat 1) (8*10^6))
--    8000000
--    (3.19 secs, 1,984,129,832 bytes)
--    λ> length (mayorPrefijoAcotado3 (repeat 1) (8*10^6))
--    8000000
--    (1.02 secs, 1,856,130,936 bytes)

import Data.List (inits)

-- 1ª solución

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

mayorPrefijoAcotado :: [Int] -> Int -> [Int]

mayorPrefijoAcotado [] _ = []

mayorPrefijoAcotado (x:xs) y

| x > y = []

| otherwise = x : mayorPrefijoAcotado xs (y-x)

-- 2ª solución

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

mayorPrefijoAcotado2 :: [Int] -> Int -> [Int]

mayorPrefijoAcotado2 xs y =

take (longitudMayorPrefijoAcotado2 xs y) xs

longitudMayorPrefijoAcotado2 :: [Int] -> Int -> Int

longitudMayorPrefijoAcotado2 xs y =

length (takeWhile (<=y) (map sum (inits xs))) - 1

-- 3ª solución

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

mayorPrefijoAcotado3 :: [Int] -> Int -> [Int]

mayorPrefijoAcotado3 xs y =

take (longitudMayorPrefijoAcotado3 xs y) xs

longitudMayorPrefijoAcotado3 :: [Int] -> Int -> Int

longitudMayorPrefijoAcotado3 xs y =

length (takeWhile (<= y) (scanl1 (+) xs))

-- Equivalencia

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

-- La propiedad es

prop_equiv :: [Int] -> Int -> Bool

prop_equiv xs y =

mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado2 xs' y' &&

mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado3 xs' y'

where xs' = map abs xs

y' = abs y

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- (0.01 secs, 2,463,688 bytes)

-- Comparación de eficiencia

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

-- λ> length (mayorPrefijoAcotado (repeat 1) (2*10^4))

-- 20000

-- (0.04 secs, 5,086,544 bytes)

-- λ> length (mayorPrefijoAcotado2 (repeat 1) (2*10^4))

-- 20000

-- (11.22 secs, 27,083,980,168 bytes)

-- λ> length (mayorPrefijoAcotado3 (repeat 1) (2*10^4))

-- 20000

-- (0.02 secs, 4,768,992 bytes)

-- λ> length (mayorPrefijoAcotado (repeat 1) (8*10^6))

-- 8000000

-- (3.19 secs, 1,984,129,832 bytes)

-- λ> length (mayorPrefijoAcotado3 (repeat 1) (8*10^6))

-- 8000000

-- (1.02 secs, 1,856,130,936 bytes)

Pensamiento

Sed hombres de mal gusto. Yo os aconsejo el mal gusto para combatir los excesos de la moda.

Antonio Machado

Subárboles monovalorados

PorJosé A. Alonso 10-enero-201917-enero-2019

Los árboles binarios con valores enteros se pueden representar mediante el tipo Arbol definido por

   data Arbol = H Int 
              | N Int Arbol Arbol
              deriving Show

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

Por ejemplo, el árbol

         7
        / \ 
       /   \
      /     \
     4       9
    / \     / \
   1   3   5   6

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9    
   / \        / \         / \        / \   
  5   5      9   9       5   6      9   7  
                / \                    / \ 
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir la función

   monovalorados :: Arbol -> [Arbol]

1	monovalorados :: Arbol -> [Arbol]

tal que (monovalorados a) es la lista de los subárboles monovalorados de a. Por ejemplo,

   λ> monovalorados (N 5 (H 5) (H 5))
   [N 5 (H 5) (H 5),H 5,H 5]
   λ> monovalorados (N 5 (H 5) (H 6))
   [H 5,H 6]
   λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))
   [N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))
   [H 9,H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))
   [H 9,H 7,H 9]

λ> monovalorados (N 5 (H 5) (H 5))

[N 5 (H 5) (H 5),H 5,H 5]

λ> monovalorados (N 5 (H 5) (H 6))

[H 5,H 6]

λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))

[N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))

[H 9,H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))

[H 9,H 7,H 9]

Soluciones

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

monovalorados :: Arbol -> [Arbol]
monovalorados (H x) = [H x]
monovalorados (N x i d) 
    | todosIguales i x && todosIguales d x =
        (N x i d) : (subarboles i ++ subarboles d)
    | otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y
-- las hojas del árbol a son iguales a x.
todosIguales :: Arbol -> Int -> Bool
todosIguales (H y) x     = y == x
todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.
subarboles :: Arbol -> [Arbol]
subarboles (H x)     = [H x]
subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]

monovalorados (H x) = [H x]

monovalorados (N x i d)

| todosIguales i x && todosIguales d x =

(N x i d) : (subarboles i ++ subarboles d)

| otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y

-- las hojas del árbol a son iguales a x.

todosIguales :: Arbol -> Int -> Bool

todosIguales (H y) x = y == x

todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.

subarboles :: Arbol -> [Arbol]

subarboles (H x) = [H x]

subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

Pensamiento

Y nadie pregunta
ni nadie contesta,
todos hablan solos.

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

El 2019 es semiprimo

PorJosé A. Alonso 3-enero-201910-enero-2019

Un número semiprimo es un número natural que es producto de dos números primos no necesariamente distintos. Por ejemplo, 26 es semiprimo (porque 26 = 2×13) y 49 también lo es (porque 49 = 7×7).

Definir las funciones

   esSemiprimo :: Integer -> Bool
   semiprimos  :: [Integer]

1 2	esSemiprimo :: Integer -> Bool semiprimos :: [Integer]

tales que

(esSemiprimo n) se verifica si n es semiprimo. Por ejemplo,

     esSemiprimo 26          ==  True
     esSemiprimo 49          ==  True
     esSemiprimo 8           ==  False
     esSemiprimo 2019        ==  True
     esSemiprimo (21+10^14)  ==  True

esSemiprimo 26 == True

esSemiprimo 49 == True

esSemiprimo 8 == False

esSemiprimo 2019 == True

esSemiprimo (21+10^14) == True

semiprimos es la sucesión de números semiprimos. Por ejemplo,

     take 10 semiprimos   ==  [4,6,9,10,14,15,21,22,25,26]
     semiprimos !! 579    ==  2019
     semiprimos !! 10000  ==  40886

take 10 semiprimos == [4,6,9,10,14,15,21,22,25,26]

semiprimos !! 579 == 2019

semiprimos !! 10000 == 40886

Soluciones

import Data.Numbers.Primes 
import Test.QuickCheck

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

esSemiprimo :: Integer -> Bool
esSemiprimo n =
  not (null [x | x <- [n,n-1..2], 
                 primo x,
                 n `mod` x == 0,
                 primo (n `div` x)])

primo :: Integer -> Bool
primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n] 

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

esSemiprimo2 :: Integer -> Bool
esSemiprimo2 n =
  not (null [x | x <- [n-1,n-2..2], 
                 isPrime x,
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

esSemiprimo3 :: Integer -> Bool
esSemiprimo3 n =
  not (null [x | x <- reverse (takeWhile (<n) primes),
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

esSemiprimo4 :: Integer -> Bool
esSemiprimo4 n =
  length (primeFactors n) == 2

-- Equivalencia de las definiciones de esSemiprimo
-- ===============================================

-- La propiedad es
prop_esSemiprimo :: Positive Integer -> Bool
prop_esSemiprimo (Positive n) =
  all (== esSemiprimo n) [f n | f <- [ esSemiprimo2
                                     , esSemiprimo3
                                     , esSemiprimo4
                                     ]]

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

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

--    λ> esSemiprimo 5001
--    True
--    (1.90 secs, 274,450,648 bytes)
--    λ> esSemiprimo2 5001
--    True
--    (0.07 secs, 29,377,016 bytes)
--    λ> esSemiprimo3 5001
--    True
--    (0.01 secs, 1,706,840 bytes)
--    λ> esSemiprimo4 5001
--    True
--    (0.01 secs, 142,840 bytes)
--    
--    λ> esSemiprimo2 100001
--    True
--    (2.74 secs, 1,473,519,064 bytes)
--    λ> esSemiprimo3 100001
--    True
--    (0.09 secs, 30,650,352 bytes)
--    λ> esSemiprimo4 100001
--    True
--    (0.01 secs, 155,200 bytes)
--    
--    λ> esSemiprimo3 10000001
--    True
--    (8.73 secs, 4,357,875,016 bytes)
--    λ> esSemiprimo4 10000001
--    True
--    (0.01 secs, 456,328 bytes)

-- Definición de semiprimos
-- ========================

semiprimos :: [Integer]
semiprimos = filter esSemiprimo4 [4..]

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición de esSemiprimo

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

esSemiprimo :: Integer -> Bool

esSemiprimo n =

not (null [x | x <- [n,n-1..2],

primo x,

n `mod` x == 0,

primo (n `div` x)])

primo :: Integer -> Bool

primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n]

-- 2ª definición de esSemiprimo

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

esSemiprimo2 :: Integer -> Bool

esSemiprimo2 n =

not (null [x | x <- [n-1,n-2..2],

isPrime x,

n `mod` x == 0,

isPrime (n `div` x)])

-- 3ª definición de esSemiprimo

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

esSemiprimo3 :: Integer -> Bool

esSemiprimo3 n =

not (null [x | x <- reverse (takeWhile (<n) primes),

n `mod` x == 0,

isPrime (n `div` x)])

-- 4ª definición de esSemiprimo

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

esSemiprimo4 :: Integer -> Bool

esSemiprimo4 n =

length (primeFactors n) == 2

-- Equivalencia de las definiciones de esSemiprimo

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

-- La propiedad es

prop_esSemiprimo :: Positive Integer -> Bool

prop_esSemiprimo (Positive n) =

all (== esSemiprimo n) [f n | f <- [ esSemiprimo2

, esSemiprimo3

, esSemiprimo4

]]

-- La comprobación es

-- λ> quickCheck prop_esSemiprimo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> esSemiprimo 5001

-- True

-- (1.90 secs, 274,450,648 bytes)

-- λ> esSemiprimo2 5001

-- True

-- (0.07 secs, 29,377,016 bytes)

-- λ> esSemiprimo3 5001

-- True

-- (0.01 secs, 1,706,840 bytes)

-- λ> esSemiprimo4 5001

-- True

-- (0.01 secs, 142,840 bytes)

-- λ> esSemiprimo2 100001

-- True

-- (2.74 secs, 1,473,519,064 bytes)

-- λ> esSemiprimo3 100001

-- True

-- (0.09 secs, 30,650,352 bytes)

-- λ> esSemiprimo4 100001

-- True

-- (0.01 secs, 155,200 bytes)

-- λ> esSemiprimo3 10000001

-- True

-- (8.73 secs, 4,357,875,016 bytes)

-- λ> esSemiprimo4 10000001

-- True

-- (0.01 secs, 456,328 bytes)

-- Definición de semiprimos

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

semiprimos :: [Integer]

semiprimos = filter esSemiprimo4 [4..]

Pensamiento

Porque toda visión requiere distancia, no hay manera de ver las cosas sin salirse de ellas.

Antonio Machado

El 2019 es malvado

PorJosé A. Alonso 2-enero-20199-enero-2019

Un número malvado es un número natural cuya expresión en base 2 contiene un número par de unos. Por ejemplo, 6 es malvado porque su expresión en base 2 es 110 que tiene dos unos.

Definir las funciones

   esMalvado       :: Integer -> Bool
   malvados        :: [Integer]
   posicionMalvada :: Integer -> Maybe Int

esMalvado :: Integer -> Bool

malvados :: [Integer]

posicionMalvada :: Integer -> Maybe Int

tales que

(esMalvado n) se verifica si n es un número malvado. Por ejemplo,

     esMalvado 6              ==  True
     esMalvado 7              ==  False
     esMalvado 2019           ==  True
     esMalvado (10^70000)     ==  True
     esMalvado (10^(3*10^7))  ==  True

esMalvado 6 == True

esMalvado 7 == False

esMalvado 2019 == True

esMalvado (10^70000) == True

esMalvado (10^(3*10^7)) == True

malvados es la sucesión de los números malvados. Por ejemplo,

     λ> take 20 malvados
     [0,3,5,6,9,10,12,15,17,18,20,23,24,27,29,30,33,34,36,39]
     malvados !! 1009    ==  2019
     malvados !! 10      ==  20
     malvados !! (10^2)  ==  201
     malvados !! (10^3)  ==  2000
     malvados !! (10^4)  ==  20001
     malvados !! (10^5)  ==  200000
     malvados !! (10^6)  ==  2000001

λ> take 20 malvados

[0,3,5,6,9,10,12,15,17,18,20,23,24,27,29,30,33,34,36,39]

malvados !! 1009 == 2019

malvados !! 10 == 20

malvados !! (10^2) == 201

malvados !! (10^3) == 2000

malvados !! (10^4) == 20001

malvados !! (10^5) == 200000

malvados !! (10^6) == 2000001

(posicionMalvada n) es justo la posición de n en la sucesión de números malvados, si n es malvado o Nothing, en caso contrario. Por ejemplo,

     posicionMalvada 6        ==  Just 3
     posicionMalvada 2019     ==  Just 1009
     posicionMalvada 2018     ==  Nothing
     posicionMalvada 2000001  ==  Just 1000000
     posicionMalvada (10^7)   ==  Just 5000000

posicionMalvada 6 == Just 3

posicionMalvada 2019 == Just 1009

posicionMalvada 2018 == Nothing

posicionMalvada 2000001 == Just 1000000

posicionMalvada (10^7) == Just 5000000

Soluciones

import Data.List (genericLength, elemIndex)
import Data.Bits (popCount)

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

esMalvado :: Integer -> Bool
esMalvado n = even (numeroUnosBin n)

-- Sin argumentos
esMalvado' :: Integer -> Bool
esMalvado' = even . numeroUnosBin

-- (numeroUnosBin n) es el número de unos de la representación binaria
-- del número decimal n. Por ejemplo,
--   numeroUnosBin 11  ==  3
--   numeroUnosBin 12  ==  2
numeroUnosBin :: Integer -> Integer
numeroUnosBin n  = genericLength (filter (== 1) (binario n))

-- Sin argumentos
numeroUnosBin' :: Integer -> Integer
numeroUnosBin' = genericLength . filter (== 1) . binario

-- (binario n) es el número binario correspondiente al número decimal n.
-- Por ejemplo, 
--   binario 11  ==  [1,1,0,1]
--   binario 12  ==  [0,0,1,1]
binario :: Integer -> [Integer]
binario n | n < 2     = [n]
          | otherwise = n `mod` 2 : binario (n `div` 2)

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

esMalvado2 :: Integer -> Bool
esMalvado2 n = even (numeroUnosBin n)

-- (numeroIntBin n) es el número de unos que contiene la representación
-- binaria del número decimal n. Por ejemplo,
--   numeroIntBin 11  ==  3
--   numeroIntBin 12  ==  2
numeroIntBin :: Integer -> Integer
numeroIntBin n | n < 2     = n
               | otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

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

esMalvado3 :: Integer -> Bool
esMalvado3 n = even (popCount n)

-- Sin argumentos
esMalvado3' :: Integer -> Bool
esMalvado3' = even . popCount 

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

--    λ> esMalvado (10^30000)
--    True
--    (1.79 secs, 664,627,936 bytes)
--    λ> esMalvado2 (10^30000)
--    True
--    (1.79 secs, 664,626,992 bytes)
--    λ> esMalvado3 (10^30000)
--    True
--    (0.03 secs, 141,432 bytes)
--    
--    λ> esMalvado (10^40000)
--    False
--    (2.95 secs, 1,162,091,464 bytes)
--    λ> esMalvado2 (10^40000)
--    False
--    (2.96 secs, 1,162,091,096 bytes)
--    λ> esMalvado3 (10^40000)
--    False
--    (0.04 secs, 155,248 bytes)

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

malvados :: [Integer]
malvados = [n | n <- [0..], esMalvado3 n]

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

malvados2 :: [Integer]
malvados2 = filter esMalvado3 [0..]

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

posicionMalvada :: Integer -> Maybe Int
posicionMalvada n
  | y == n    = Just (length xs)
  | otherwise = Nothing
  where (xs,(y:_)) = span (<n) malvados

-- 2ª definición de posicionMalvada
posicionMalvada2 :: Integer -> Maybe Int
posicionMalvada2 n
  | esMalvado n = elemIndex n malvados
  | otherwise        = Nothing

100

101

102

103

104

105

import Data.List (genericLength, elemIndex)

import Data.Bits (popCount)

-- 1ª definición de esMalvado

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

esMalvado :: Integer -> Bool

esMalvado n = even (numeroUnosBin n)

-- Sin argumentos

esMalvado' :: Integer -> Bool

esMalvado' = even . numeroUnosBin

-- (numeroUnosBin n) es el número de unos de la representación binaria

-- del número decimal n. Por ejemplo,

-- numeroUnosBin 11 == 3

-- numeroUnosBin 12 == 2

numeroUnosBin :: Integer -> Integer

numeroUnosBin n = genericLength (filter (== 1) (binario n))

-- Sin argumentos

numeroUnosBin' :: Integer -> Integer

numeroUnosBin' = genericLength . filter (== 1) . binario

-- (binario n) es el número binario correspondiente al número decimal n.

-- Por ejemplo,

-- binario 11 == [1,1,0,1]

-- binario 12 == [0,0,1,1]

binario :: Integer -> [Integer]

binario n | n < 2 = [n]

| otherwise = n `mod` 2 : binario (n `div` 2)

-- 2ª definición de esMalvado

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

esMalvado2 :: Integer -> Bool

esMalvado2 n = even (numeroUnosBin n)

-- (numeroIntBin n) es el número de unos que contiene la representación

-- binaria del número decimal n. Por ejemplo,

-- numeroIntBin 11 == 3

-- numeroIntBin 12 == 2

numeroIntBin :: Integer -> Integer

numeroIntBin n | n < 2 = n

| otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

-- 3ª definición de esMalvado

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

esMalvado3 :: Integer -> Bool

esMalvado3 n = even (popCount n)

-- Sin argumentos

esMalvado3' :: Integer -> Bool

esMalvado3' = even . popCount

-- Comparación de eficiencia

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

-- λ> esMalvado (10^30000)

-- True

-- (1.79 secs, 664,627,936 bytes)

-- λ> esMalvado2 (10^30000)

-- True

-- (1.79 secs, 664,626,992 bytes)

-- λ> esMalvado3 (10^30000)

-- True

-- (0.03 secs, 141,432 bytes)

-- λ> esMalvado (10^40000)

-- False

-- (2.95 secs, 1,162,091,464 bytes)

-- λ> esMalvado2 (10^40000)

-- False

-- (2.96 secs, 1,162,091,096 bytes)

-- λ> esMalvado3 (10^40000)

-- False

-- (0.04 secs, 155,248 bytes)

-- 1ª definición de malvados

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

malvados :: [Integer]

malvados = [n | n <- [0..], esMalvado3 n]

-- 2ª definición de malvados

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

malvados2 :: [Integer]

malvados2 = filter esMalvado3 [0..]

-- 1ª definición de posicionMalvada

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

posicionMalvada :: Integer -> Maybe Int

posicionMalvada n

| y == n = Just (length xs)

| otherwise = Nothing

where (xs,(y:_)) = span (<n) malvados

-- 2ª definición de posicionMalvada

posicionMalvada2 :: Integer -> Maybe Int

posicionMalvada2 n

| esMalvado n = elemIndex n malvados

| otherwise = Nothing

Pensamiento

… Yo os enseño, o pretendo enseñaros a que dudéis de todo: de lo
humano y de lo divino, sin excluir vuestra propia existencia.

Antonio Machado

El 2019 es apocalíptico

PorJosé A. Alonso 1-enero-20198-enero-2019

Un número natural n es apocalíptico si 2^n contiene la secuencia 666. Por ejemplo, 157 es apocalíptico porque 2^157 es 182687704666362864775460604089535377456991567872 que contiene la secuencia 666.

Definir las funciones

   esApocaliptico       :: Integer -> Bool
   apocalipticos        :: [Integer]
   posicionApocaliptica :: Integer -> Maybe Int

esApocaliptico :: Integer -> Bool

apocalipticos :: [Integer]

posicionApocaliptica :: Integer -> Maybe Int

tales que

(esApocaliptico n) se verifica si n es un número apocalíptico. Por ejemplo,

     esApocaliptico 157   ==  True
     esApocaliptico 2019  ==  True
     esApocaliptico 2018  ==  False

esApocaliptico 157 == True

esApocaliptico 2019 == True

esApocaliptico 2018 == False

apocalipticos es la lista de los números apocalípticos. Por ejemplo,

     take 9 apocalipticos  ==  [157,192,218,220,222,224,226,243,245]
     apocalipticos !! 450  ==  2019

1 2	take 9 apocalipticos == [157,192,218,220,222,224,226,243,245] apocalipticos !! 450 == 2019

(posicionApocalitica n) es justo la posición de n en la sucesión de números apocalípticos, si n es apocalíptico o Nothing, en caso contrario. Por ejemplo,

     posicionApocaliptica 157   ==  Just 0
     posicionApocaliptica 2019  ==  Just 450
     posicionApocaliptica 2018  ==  Nothing

posicionApocaliptica 157 == Just 0

posicionApocaliptica 2019 == Just 450

posicionApocaliptica 2018 == Nothing

Soluciones

import Data.List (isInfixOf, elemIndex)

-- 1ª definición de esApocaliptico
esApocaliptico :: Integer -> Bool
esApocaliptico n = "666" `isInfixOf` show (2^n)

-- 2ª definición de esApocaliptico
esApocaliptico2 :: Integer -> Bool
esApocaliptico2 = isInfixOf "666" . show . (2^)

-- 1ª definición de apocalipticos
apocalipticos :: [Integer]
apocalipticos = [n | n <- [1..], esApocaliptico n]

-- 2ª definición de apocalipticos
apocalipticos2 :: [Integer]
apocalipticos2 = filter esApocaliptico [1..]

-- 1ª definición de posicionApocaliptica
posicionApocaliptica :: Integer -> Maybe Int
posicionApocaliptica n
  | y == n    = Just (length xs)
  | otherwise = Nothing
  where (xs,y:_) = span (<n) apocalipticos

-- 2ª definición de posicionApocaliptica
posicionApocaliptica2 :: Integer -> Maybe Int
posicionApocaliptica2 n
  | esApocaliptico n = elemIndex n apocalipticos
  | otherwise        = Nothing

import Data.List (isInfixOf, elemIndex)

-- 1ª definición de esApocaliptico

esApocaliptico :: Integer -> Bool

esApocaliptico n = "666" `isInfixOf` show (2^n)

-- 2ª definición de esApocaliptico

esApocaliptico2 :: Integer -> Bool

esApocaliptico2 = isInfixOf "666" . show . (2^)

-- 1ª definición de apocalipticos

apocalipticos :: [Integer]

apocalipticos = [n | n <- [1..], esApocaliptico n]

-- 2ª definición de apocalipticos

apocalipticos2 :: [Integer]

apocalipticos2 = filter esApocaliptico [1..]

-- 1ª definición de posicionApocaliptica

posicionApocaliptica :: Integer -> Maybe Int

posicionApocaliptica n

| y == n = Just (length xs)

| otherwise = Nothing

where (xs,y:_) = span (<n) apocalipticos

-- 2ª definición de posicionApocaliptica

posicionApocaliptica2 :: Integer -> Maybe Int

posicionApocaliptica2 n

| esApocaliptico n = elemIndex n apocalipticos

| otherwise = Nothing

Pensamiento

A vosotros no os importe pensar lo que habéis leído ochenta veces y oído
quinientas, porque no es lo mismo pensar que haber leído.

Antonio Machado

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico