Comprensión – Página 7

Siguiente mayor

PorJosé A. Alonso 20-marzo-201926-marzo-2022

Definir la función

   siguienteMayor :: Ord a => [a] -> [Maybe a]

1	siguienteMayor :: Ord a => [a] -> [Maybe a]

tal que (siguienteMayos xs) es la lista obtenida sustiyendo cada elemento de xs por el primer elemento de xs a la derechha de x que sea mayor que x, si existe y Nothing en caso contrario. Por ejemplo,

   λ> siguienteMayor [4,5,2,3,9]
   [Just 5,Just 9,Just 3,Just 9,Nothing]
   λ> siguienteMayor [9,5,2,3,4]
   [Nothing,Nothing,Just 3,Just 4,Nothing]
   λ> siguienteMayor [9,5,2,2,4]
   [Nothing,Nothing,Just 4,Just 4,Nothing]
   λ> siguienteMayor "betis"
   [Just 'e',Just 't',Nothing,Just 's',Nothing]
   λ> siguienteMayor "sevilla"
   [Just 'v',Just 'v',Nothing,Just 'l',Nothing,Nothing,Nothing]

λ> siguienteMayor [4,5,2,3,9]

[Just 5,Just 9,Just 3,Just 9,Nothing]

λ> siguienteMayor [9,5,2,3,4]

[Nothing,Nothing,Just 3,Just 4,Nothing]

λ> siguienteMayor [9,5,2,2,4]

[Nothing,Nothing,Just 4,Just 4,Nothing]

λ> siguienteMayor "betis"

[Just 'e',Just 't',Nothing,Just 's',Nothing]

λ> siguienteMayor "sevilla"

[Just 'v',Just 'v',Nothing,Just 'l',Nothing,Nothing,Nothing]

Soluciones

import Data.Maybe (listToMaybe)

-- 1ª solución
siguienteMayor :: Ord a => [a] -> [Maybe a]
siguienteMayor [] = []
siguienteMayor (x:xs)
  | null ys   = Nothing : siguienteMayor xs
  | otherwise = Just (head ys) : siguienteMayor xs
  where ys = [y | y <- xs, y > x]

-- 2ª solución
siguienteMayor2 :: Ord a => [a] -> [Maybe a]
siguienteMayor2 []     = []
siguienteMayor2 (x:xs) = listToMaybe [y | y <- xs, y > x] : siguienteMayor2 xs

-- 3ª solución
siguienteMayor3 :: Ord a => [a] -> [Maybe a]
siguienteMayor3 []     = []
siguienteMayor3 (x:xs) = listToMaybe (dropWhile (<=x) xs) : siguienteMayor3 xs

import Data.Maybe (listToMaybe)

-- 1ª solución

siguienteMayor :: Ord a => [a] -> [Maybe a]

siguienteMayor [] = []

siguienteMayor (x:xs)

| null ys = Nothing : siguienteMayor xs

| otherwise = Just (head ys) : siguienteMayor xs

where ys = [y | y <- xs, y > x]

-- 2ª solución

siguienteMayor2 :: Ord a => [a] -> [Maybe a]

siguienteMayor2 [] = []

siguienteMayor2 (x:xs) = listToMaybe [y | y <- xs, y > x] : siguienteMayor2 xs

-- 3ª solución

siguienteMayor3 :: Ord a => [a] -> [Maybe a]

siguienteMayor3 [] = []

siguienteMayor3 (x:xs) = listToMaybe (dropWhile (<=x) xs) : siguienteMayor3 xs

Pensamiento

Si vivir es bueno
es mejor soñar,
y mejor que todo,
madre, despertar.

Antonio Machado

Caminos minimales en un árbol numérico

PorJosé A. Alonso 19-marzo-201930-marzo-2019

En la librería Data.Tree se definen los tipos de árboles y bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u.v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que
+ (mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree
import Test.QuickCheck

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

import Test.QuickCheck

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

-- [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Pensamiento

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

Antonio Machado

Cambio con el menor número de monedas

PorJosé A. Alonso 15-marzo-201926-marzo-2022

El problema del cambio con el menor número de monedas consiste en, dada una lista ms de tipos de monedas (con infinitas monedas de cada tipo) y una cantidad objetivo x, calcular el menor número de monedas de ms cuya suma es x. Por ejemplo, con monedas de 1, 3 y 4 céntimos se puede obtener 6 céntimos de 4 formas

   1, 1, 1, 1, 1, 1
   1, 1, 1, 3
   1, 1, 4
   3, 3

1, 1, 1, 1, 1, 1

1, 1, 1, 3

1, 1, 4

3, 3

El menor número de monedas que se necesita es 2. En cambio, con monedas de 2, 5 y 10 es imposible obtener 3.

Definir

   monedas :: [Int] -> Int -> Maybe Int

1	monedas :: [Int] -> Int -> Maybe Int

tal que (monedas ms x) es el menor número de monedas de ms cuya suma es x, si es posible obtener dicha suma y es Nothing en caso contrario. Por ejemplo,

   monedas [1,3,4]  6                    ==  Just 2
   monedas [2,5,10] 3                    ==  Nothing
   monedas [1,2,5,10,20,50,100,200] 520  ==  Just 4

monedas [1,3,4] 6 == Just 2

monedas [2,5,10] 3 == Nothing

monedas [1,2,5,10,20,50,100,200] 520 == Just 4

Soluciones

import Data.Array ((!), array)

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

monedas :: [Int] -> Int -> Maybe Int
monedas ms x
  | null cs   = Nothing
  | otherwise = Just (minimum (map length cs))
  where cs = cambios ms x

-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas
-- de ms. Por ejemplo,
--   λ> cambios [1,5,10] 12
--   [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]
--   λ> cambios [2,5,10] 3
--   []
--   λ> cambios [1,3,4] 6
--   [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]
cambios :: [Int] -> Int -> [[Int]]
cambios _      0 = [[]]
cambios []     _ = []
cambios (k:ks) m
  | m < k     = []
  | otherwise = [k:zs | zs <- cambios (k:ks) (m - k)] ++
                cambios ks m

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

monedas2 :: [Int] -> Int -> Maybe Int
monedas2 ms n
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = aux n
    aux 0 = 0
    aux k = siguiente (minimo [aux (k - x) | x <- ms,  k >= x])

infinito :: Int
infinito = 10^30

minimo :: [Int] -> Int
minimo [] = infinito
minimo xs = minimum xs

siguiente :: Int -> Int
siguiente x | x == infinito = infinito
            | otherwise     = 1 + x

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

monedas3 :: [Int] -> Int -> Maybe Int
monedas3 ms n  
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = v ! n
    v   = array (0,n) [(i,f i) | i <- [0..n]]
    f 0 = 0
    f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])

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

--    λ> monedas [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.02 secs, 871,144 bytes)
--    λ> monedas2 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (15.44 secs, 1,866,519,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.01 secs, 157,232 bytes)
--    
--    λ> monedas [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (14.20 secs, 1,845,293,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (0.01 secs, 623,376 bytes)

import Data.Array ((!), array)

-- 1ª solución

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

monedas :: [Int] -> Int -> Maybe Int

monedas ms x

| null cs = Nothing

| otherwise = Just (minimum (map length cs))

where cs = cambios ms x

-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas

-- de ms. Por ejemplo,

-- λ> cambios [1,5,10] 12

-- [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]

-- λ> cambios [2,5,10] 3

-- []

-- λ> cambios [1,3,4] 6

-- [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]

cambios :: [Int] -> Int -> [[Int]]

cambios _ 0 = [[]]

cambios [] _ = []

cambios (k:ks) m

| m < k = []

| otherwise = [k:zs | zs <- cambios (k:ks) (m - k)] ++

cambios ks m

-- 2ª solución

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

monedas2 :: [Int] -> Int -> Maybe Int

monedas2 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = aux n

aux 0 = 0

aux k = siguiente (minimo [aux (k - x) | x <- ms, k >= x])

infinito :: Int

infinito = 10^30

minimo :: [Int] -> Int

minimo [] = infinito

minimo xs = minimum xs

siguiente :: Int -> Int

siguiente x | x == infinito = infinito

| otherwise = 1 + x

-- 3ª solución

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

monedas3 :: [Int] -> Int -> Maybe Int

monedas3 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = v ! n

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

f 0 = 0

f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])

-- Comparación de eficiencia

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

-- λ> monedas [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (0.02 secs, 871,144 bytes)

-- λ> monedas2 [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (15.44 secs, 1,866,519,080 bytes)

-- λ> monedas3 [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (0.01 secs, 157,232 bytes)

-- λ> monedas [1,2,5,10,20,50,100,200] 188

-- Just 7

-- (14.20 secs, 1,845,293,080 bytes)

-- λ> monedas3 [1,2,5,10,20,50,100,200] 188

-- Just 7

-- (0.01 secs, 623,376 bytes)

Pensamiento

Demos tiempo al tiempo:
para que el vaso rebose
hay que llenarlo primero.

Antonio Machado

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 14-marzo-201925-abril-2021

Definir la función

   longitudMayorSublistaCreciente :: Ord a => [a] -> Int

1	longitudMayorSublistaCreciente :: Ord a => [a] -> Int

tal que (longitudMayorSublistaCreciente xs) es la el máximo de las longitudes de las sublistas crecientes de xs. Por ejemplo,

   λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
   3
   λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
   6
   λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   6
   λ> longitudMayorSublistaCreciente [1..2000]
   2000
   λ> longitudMayorSublistaCreciente [2000,1999..1]
   1
   λ> import System.Random
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> longitudMayorSublistaCreciente2 xs
   61
   λ> longitudMayorSublistaCreciente3 xs
   61

λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]

λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]

λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> longitudMayorSublistaCreciente2 xs

λ> longitudMayorSublistaCreciente3 xs

Soluciones

import Data.List  (nub, sort)
import Data.Array (Array, (!), array, elems, listArray)

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

longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente1 =
  length . head . mayoresCrecientes

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs
-- de mayor longitud. Por ejemplo, 
--    λ> mayoresCrecientes [3,2,6,4,5,1]
--    [[3,4,5],[2,4,5]]
--    λ> mayoresCrecientes [3,2,3,2,3,1]
--    [[2,3],[2,3],[2,3]]
--    λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
--    [[10,22,33,50,60,80],[10,22,33,41,60,80]]
--    λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
--    [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
mayoresCrecientes :: Ord a => [a] -> [[a]]
mayoresCrecientes xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes []  = [[]]
sublistasCrecientes (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes xs

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

longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente2 xs =
  longitudSCM xs (sort (nub xs))
  
-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e
-- ys. Por ejemplo, 
--   longitudSCM "amapola" "matamoscas" == 4
--   longitudSCM "atamos" "matamoscas"  == 6
--   longitudSCM "aaa" "bbbb"           == 0
longitudSCM :: Eq a => [a] -> [a] -> Int
longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)
  where n = length xs
        m = length ys

-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n
-- y m son los números de elementos de xs e ys, respectivamente) tal que
-- el valor en la posición (i,j) es la longitud de la SCM de los i
-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,
--    λ> elems (matrizLongitudSCM "amapola" "matamoscas")
--    [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,
--     0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,
--     0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]
-- Gráficamente,
--       m a t a m o s c a s
--    [0,0,0,0,0,0,0,0,0,0,0,
-- a   0,0,1,1,1,1,1,1,1,1,1,
-- m   0,1,1,1,1,2,2,2,2,2,2,
-- a   0,1,2,2,2,2,2,2,2,3,3,
-- p   0,1,2,2,2,2,2,2,2,3,3,
-- o   0,1,2,2,2,2,3,3,3,3,3,
-- l   0,1,2,2,2,2,3,3,3,3,3,
-- a   0,1,2,2,3,3,3,3,3,4,4]
matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int
matrizLongitudSCM xs ys = q
  where
    n = length xs
    m = length ys
    v = listArray (1,n) xs
    w = listArray (1,m) ys
    q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
      where f 0 _ = 0
            f _ 0 = 0
            f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)
                  | otherwise      = max (q ! (i-1,j)) (q ! (i,j-1))
  
-- 3ª solución
-- ===========

longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente3 xs =
  maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n
-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud
-- de la sucesión más larga que termina en el elemento i-ésimo de
-- xs. Por ejemplo,  
--    λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]
--    array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]
vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int
vectorlongitudMayorSublistaCreciente xs = v
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        n = length xs
        w = listArray (1,n) xs
        f 1 = 1
        f i | null ls   = 1
            | otherwise = 1 + maximum ls
          where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]

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

--    λ> longitudMayorSublistaCreciente1 [1..20]
--    20
--    (4.60 secs, 597,014,240 bytes)
--    λ> longitudMayorSublistaCreciente2 [1..20]
--    20
--    (0.03 secs, 361,384 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..20]
--    20
--    (0.03 secs, 253,944 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 [1..2000]
--    2000
--    (8.00 secs, 1,796,495,488 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..2000]
--    2000
--    (5.12 secs, 1,137,667,496 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 [1000,999..1]
--    1
--    (0.95 secs, 97,029,328 bytes)
--    λ> longitudMayorSublistaCreciente2 [1000,999..1]
--    1
--    (7.48 secs, 1,540,857,208 bytes)
--    λ> longitudMayorSublistaCreciente3 [1000,999..1]
--    1
--    (0.86 secs, 160,859,128 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 (show (2^300))
--    10
--    (7.90 secs, 887,495,368 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^300))
--    10
--    (0.04 secs, 899,152 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^300))
--    10
--    (0.04 secs, 1,907,936 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 (show (2^6000))
--    10
--    (0.06 secs, 9,950,592 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^6000))
--    10
--    (3.46 secs, 686,929,744 bytes)
--    
--    λ> import System.Random
--    (0.00 secs, 0 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.02 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    61
--    (7.73 secs, 1,538,771,392 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    61
--    (1.04 secs, 212,538,648 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.03 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    57
--    (7.56 secs, 1,538,573,680 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    57
--    (1.05 secs, 212,293,984 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

import Data.List (nub, sort)

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

-- 1ª solución

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

longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int

longitudMayorSublistaCreciente1 =

length . head . mayoresCrecientes

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs

-- de mayor longitud. Por ejemplo,

-- λ> mayoresCrecientes [3,2,6,4,5,1]

-- [[3,4,5],[2,4,5]]

-- λ> mayoresCrecientes [3,2,3,2,3,1]

-- [[2,3],[2,3],[2,3]]

-- λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]

-- [[10,22,33,50,60,80],[10,22,33,41,60,80]]

-- λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]

-- [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]

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

mayoresCrecientes xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

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

sublistasCrecientes [] = [[]]

sublistasCrecientes (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes xs

-- 2ª solución

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

longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int

longitudMayorSublistaCreciente2 xs =

longitudSCM xs (sort (nub xs))

-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e

-- ys. Por ejemplo,

-- longitudSCM "amapola" "matamoscas" == 4

-- longitudSCM "atamos" "matamoscas" == 6

-- longitudSCM "aaa" "bbbb" == 0

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

longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)

where n = length xs

m = length ys

-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n

-- y m son los números de elementos de xs e ys, respectivamente) tal que

-- el valor en la posición (i,j) es la longitud de la SCM de los i

-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,

-- λ> elems (matrizLongitudSCM "amapola" "matamoscas")

-- [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,

-- 0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,

-- 0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]

-- Gráficamente,

-- m a t a m o s c a s

-- [0,0,0,0,0,0,0,0,0,0,0,

-- a 0,0,1,1,1,1,1,1,1,1,1,

-- m 0,1,1,1,1,2,2,2,2,2,2,

-- a 0,1,2,2,2,2,2,2,2,3,3,

-- p 0,1,2,2,2,2,2,2,2,3,3,

-- o 0,1,2,2,2,2,3,3,3,3,3,

-- l 0,1,2,2,2,2,3,3,3,3,3,

-- a 0,1,2,2,3,3,3,3,3,4,4]

matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int

matrizLongitudSCM xs ys = q

where

n = length xs

m = length ys

v = listArray (1,n) xs

w = listArray (1,m) ys

q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]

where f 0 _ = 0

f _ 0 = 0

f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)

| otherwise = max (q ! (i-1,j)) (q ! (i,j-1))

-- 3ª solución

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

longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int

longitudMayorSublistaCreciente3 xs =

maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n

-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud

-- de la sucesión más larga que termina en el elemento i-ésimo de

-- xs. Por ejemplo,

-- λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]

-- array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]

vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int

vectorlongitudMayorSublistaCreciente xs = v

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

n = length xs

w = listArray (1,n) xs

f 1 = 1

f i | null ls = 1

| otherwise = 1 + maximum ls

where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]

-- Comparación de eficiencia

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

-- λ> longitudMayorSublistaCreciente1 [1..20]

-- 20

-- (4.60 secs, 597,014,240 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..20]

-- 20

-- (0.03 secs, 361,384 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..20]

-- 20

-- (0.03 secs, 253,944 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..2000]

-- 2000

-- (8.00 secs, 1,796,495,488 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..2000]

-- 2000

-- (5.12 secs, 1,137,667,496 bytes)

-- λ> longitudMayorSublistaCreciente1 [1000,999..1]

-- 1

-- (0.95 secs, 97,029,328 bytes)

-- λ> longitudMayorSublistaCreciente2 [1000,999..1]

-- 1

-- (7.48 secs, 1,540,857,208 bytes)

-- λ> longitudMayorSublistaCreciente3 [1000,999..1]

-- 1

-- (0.86 secs, 160,859,128 bytes)

-- λ> longitudMayorSublistaCreciente1 (show (2^300))

-- 10

-- (7.90 secs, 887,495,368 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^300))

-- 10

-- (0.04 secs, 899,152 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^300))

-- 10

-- (0.04 secs, 1,907,936 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^6000))

-- 10

-- (0.06 secs, 9,950,592 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^6000))

-- 10

-- (3.46 secs, 686,929,744 bytes)

-- λ> import System.Random

-- (0.00 secs, 0 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.02 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 61

-- (7.73 secs, 1,538,771,392 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 61

-- (1.04 secs, 212,538,648 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.03 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 57

-- (7.56 secs, 1,538,573,680 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 57

-- (1.05 secs, 212,293,984 bytes)

Pensamiento

No es el yo fundamental
eso que busca el poeta,
sino el tú esencial.

Antonio Machado

Números cíclopes

PorJosé A. Alonso 12-marzo-201926-marzo-2022

Un número cíclope es un número natural cuya representación binaria sólo tiene un cero en el centro. Por ejemplo,

     0      es ciclope porque su representación binaria es 0       
     1   no es ciclope porque su representación binaria es 1       
     5      es ciclope porque su representación binaria es 101     
     9   no es ciclope porque su representación binaria es 1001    
    10   no es ciclope porque su representación binaria es 1010    
    27      es ciclope porque su representación binaria es 11011   
    85   no es ciclope porque su representación binaria es 1010101 
   101   no es ciclope porque su representación binaria es 1100101 
   111   no es ciclope porque su representación binaria es 1101111 
   119      es ciclope porque su representación binaria es 1110111

0 es ciclope porque su representación binaria es 0

1 no es ciclope porque su representación binaria es 1

5 es ciclope porque su representación binaria es 101

9 no es ciclope porque su representación binaria es 1001

10 no es ciclope porque su representación binaria es 1010

27 es ciclope porque su representación binaria es 11011

85 no es ciclope porque su representación binaria es 1010101

101 no es ciclope porque su representación binaria es 1100101

111 no es ciclope porque su representación binaria es 1101111

119 es ciclope porque su representación binaria es 1110111

Definir las funciones

   esCiclope       :: Integer -> Bool
   ciclopes        :: [Integer]
   graficaCiclopes :: Int -> IO ()

esCiclope :: Integer -> Bool

ciclopes :: [Integer]

graficaCiclopes :: Int -> IO ()

tales que

(esCiclope n) se verifica si el número natual n es cíclope. Por ejemplo,

      esCiclope 0    ==  True
      esCiclope 1    ==  False
      esCiclope 5    ==  True
      esCiclope 9    ==  False
      esCiclope 10   ==  False
      esCiclope 27   ==  True
      esCiclope 85   ==  False
      esCiclope 101  ==  False
      esCiclope 111  ==  False
      esCiclope 119  ==  True

esCiclope 0 == True

esCiclope 1 == False

esCiclope 5 == True

esCiclope 9 == False

esCiclope 10 == False

esCiclope 27 == True

esCiclope 85 == False

esCiclope 101 == False

esCiclope 111 == False

esCiclope 119 == True

ciclopes es la lista de los número cíclopes. Por ejemplo,

     λ> take 12 ciclopes
     [0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]
     λ> length (show (ciclopes !! (10^5)))
     60207

λ> take 12 ciclopes

[0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]

λ> length (show (ciclopes !! (10^5)))

60207

(graficaCiclopes n) dibuja la gráfica del último dígito de los n primeros números cíclopes. Por ejemplo, (graficaCiclopes n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

--    esCiclope 5  ==  True
--    esCiclope 6  ==  False
esCiclope :: Integer -> Bool
esCiclope n =
  esCiclopeBinario (decimalAbinario n)

--    decimalAbinario 4  ==  [0,0,1]
--    decimalAbinario 5  ==  [1,0,1]
--    decimalAbinario 6  ==  [0,1,1]
decimalAbinario :: Integer -> [Integer]
decimalAbinario 0 = [0]
decimalAbinario 1 = [1]
decimalAbinario n = r : decimalAbinario q
  where (q,r) = quotRem n 2

--    esCiclopeBinario [1,1,0,1,1]  ==  True
--    esCiclopeBinario [1,1,0,1]  ==  False
--    esCiclopeBinario [1,1,2,1,1]  ==  False
--    esCiclopeBinario [2,2,0,2,2]  ==  False
esCiclopeBinario :: [Integer] -> Bool
esCiclopeBinario xs =
  odd n && xs == ys ++ 0 : ys
  where n  = length xs
        m  = n `div` 2
        ys = replicate m 1

--    take 8 ciclopes  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes :: [Integer]
ciclopes = filter esCiclope [0..]

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

--    take 8 ciclopes2  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes2 :: [Integer]
ciclopes2 =
  [binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]

--    binarioAdecimal [0,1,1]  ==  6
binarioAdecimal :: [Integer] -> Integer
binarioAdecimal [x]    = x
binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs

esCiclope2 :: Integer -> Bool
esCiclope2 n =
  n `pertenece` ciclopes2

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

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

--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes3 :: [Integer]
ciclopes3 =
  [sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]

esCiclope3 :: Integer -> Bool
esCiclope3 n =
  n `pertenece` ciclopes3

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

--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes4 :: [Integer]
ciclopes4 =
  [2^(2*n+1) - 1 - 2^n | n <- [0..]]

esCiclope4 :: Integer -> Bool
esCiclope4 n =
  n `pertenece` ciclopes4


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

--    take 8 ciclopes5  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes5 :: [Integer]
ciclopes5 =
  [2*4^n - 1 - 2^n | n <- [0..]]

esCiclope5 :: Integer -> Bool
esCiclope5 n =
  n `pertenece` ciclopes5

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

--    take 8 ciclopes6  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes6 :: [Integer]
ciclopes6 =
  [2*x*x - 1 - x | x <- iterate (*2) 1]
  
esCiclope6 :: Integer -> Bool
esCiclope6 n =
  n `pertenece` ciclopes6



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

--    λ> ciclopes !! 9
--    523775
--    (6.68 secs, 4,696,734,960 bytes)
--    λ> ciclopes2 !! 9
--    523775
--    (0.00 secs, 134,664 bytes)
--    λ> ciclopes3 !! 9
--    523775
--    (0.00 secs, 150,920 bytes)
--    λ> ciclopes4 !! 9
--    523775
--    (0.01 secs, 131,936 bytes)
--    λ> ciclopes5 !! 9
--    523775
--    (0.00 secs, 132,064 bytes)
--
--    λ> length (show (ciclopes2 !! (3*10^4)))
--    18063
--    (0.65 secs, 486,437,480 bytes)
--    λ> length (show (ciclopes3 !! (3*10^4)))
--    18063
--    (2.94 secs, 1,188,645,584 bytes)
--    λ> length (show (ciclopes4 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,769,592 bytes)
--    λ> length (show (ciclopes5 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,773,552 bytes)
--
--    λ> length (show (ciclopes2 !! (10^5)))
--    60207
--    (6.42 secs, 5,148,671,368 bytes)
--    λ> length (show (ciclopes4 !! (10^5)))
--    60207
--    (0.07 secs, 22,291,480 bytes)
--    λ> length (show (ciclopes5 !! (10^5)))
--    60207
--    (0.04 secs, 22,316,216 bytes)
--    
--    λ> length (show (ciclopes4 !! (5*10^6)))
--    3010301
--    (2.34 secs, 1,116,327,832 bytes)
--    λ> length (show (ciclopes5 !! (5*10^6)))
--    3010301
--    (2.39 secs, 1,099,177,056 bytes)

-- Definición de graficaCiclopes
-- =============================

graficaCiclopes :: Int -> IO ()
graficaCiclopes n =
  plotList [ Key Nothing
           -- , PNG "Numeros_ciclopes.png"
           ]
           [x `mod` 10 | x <- take n ciclopes5]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

import Graphics.Gnuplot.Simple

-- 1ª solución

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

-- esCiclope 5 == True

-- esCiclope 6 == False

esCiclope :: Integer -> Bool

esCiclope n =

esCiclopeBinario (decimalAbinario n)

-- decimalAbinario 4 == [0,0,1]

-- decimalAbinario 5 == [1,0,1]

-- decimalAbinario 6 == [0,1,1]

decimalAbinario :: Integer -> [Integer]

decimalAbinario 0 = [0]

decimalAbinario 1 = [1]

decimalAbinario n = r : decimalAbinario q

where (q,r) = quotRem n 2

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

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

-- esCiclopeBinario [1,1,2,1,1] == False

-- esCiclopeBinario [2,2,0,2,2] == False

esCiclopeBinario :: [Integer] -> Bool

esCiclopeBinario xs =

odd n && xs == ys ++ 0 : ys

where n = length xs

m = n `div` 2

ys = replicate m 1

-- take 8 ciclopes == [0,5,27,119,495,2015,8127,32639]

ciclopes :: [Integer]

ciclopes = filter esCiclope [0..]

-- 2ª solución

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

-- take 8 ciclopes2 == [0,5,27,119,495,2015,8127,32639]

ciclopes2 :: [Integer]

ciclopes2 =

[binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]

-- binarioAdecimal [0,1,1] == 6

binarioAdecimal :: [Integer] -> Integer

binarioAdecimal [x] = x

binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs

esCiclope2 :: Integer -> Bool

esCiclope2 n =

n `pertenece` ciclopes2

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

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

-- 3ª solución

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

-- take 8 ciclopes3 == [0,5,27,119,495,2015,8127,32639]

ciclopes3 :: [Integer]

ciclopes3 =

[sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]

esCiclope3 :: Integer -> Bool

esCiclope3 n =

n `pertenece` ciclopes3

-- 4ª solución

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

-- take 8 ciclopes3 == [0,5,27,119,495,2015,8127,32639]

ciclopes4 :: [Integer]

ciclopes4 =

[2^(2*n+1) - 1 - 2^n | n <- [0..]]

esCiclope4 :: Integer -> Bool

esCiclope4 n =

n `pertenece` ciclopes4

-- 5ª solución

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

-- take 8 ciclopes5 == [0,5,27,119,495,2015,8127,32639]

ciclopes5 :: [Integer]

ciclopes5 =

[2*4^n - 1 - 2^n | n <- [0..]]

esCiclope5 :: Integer -> Bool

esCiclope5 n =

n `pertenece` ciclopes5

-- 6ª solución

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

-- take 8 ciclopes6 == [0,5,27,119,495,2015,8127,32639]

ciclopes6 :: [Integer]

ciclopes6 =

[2*x*x - 1 - x | x <- iterate (*2) 1]

esCiclope6 :: Integer -> Bool

esCiclope6 n =

n `pertenece` ciclopes6

-- Comparación de eficiencia

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

-- λ> ciclopes !! 9

-- 523775

-- (6.68 secs, 4,696,734,960 bytes)

-- λ> ciclopes2 !! 9

-- 523775

-- (0.00 secs, 134,664 bytes)

-- λ> ciclopes3 !! 9

-- 523775

-- (0.00 secs, 150,920 bytes)

-- λ> ciclopes4 !! 9

-- 523775

-- (0.01 secs, 131,936 bytes)

-- λ> ciclopes5 !! 9

-- 523775

-- (0.00 secs, 132,064 bytes)

-- λ> length (show (ciclopes2 !! (3*10^4)))

-- 18063

-- (0.65 secs, 486,437,480 bytes)

-- λ> length (show (ciclopes3 !! (3*10^4)))

-- 18063

-- (2.94 secs, 1,188,645,584 bytes)

-- λ> length (show (ciclopes4 !! (3*10^4)))

-- 18063

-- (0.02 secs, 6,769,592 bytes)

-- λ> length (show (ciclopes5 !! (3*10^4)))

-- 18063

-- (0.02 secs, 6,773,552 bytes)

-- λ> length (show (ciclopes2 !! (10^5)))

-- 60207

-- (6.42 secs, 5,148,671,368 bytes)

-- λ> length (show (ciclopes4 !! (10^5)))

-- 60207

-- (0.07 secs, 22,291,480 bytes)

-- λ> length (show (ciclopes5 !! (10^5)))

-- 60207

-- (0.04 secs, 22,316,216 bytes)

-- λ> length (show (ciclopes4 !! (5*10^6)))

-- 3010301

-- (2.34 secs, 1,116,327,832 bytes)

-- λ> length (show (ciclopes5 !! (5*10^6)))

-- 3010301

-- (2.39 secs, 1,099,177,056 bytes)

-- Definición de graficaCiclopes

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

graficaCiclopes :: Int -> IO ()

graficaCiclopes n =

plotList [ Key Nothing

-- , PNG "Numeros_ciclopes.png"

]

[x `mod` 10 | x <- take n ciclopes5]

Pensamiento

¿Sabes cuando el agua suena,
si es agua de cumbre o valle,
de plaza, jardín o huerta?
Cantores, dejad
palmas y jaleo
para los demás.

Antonio Machado

Combinaciones divisibles

PorJosé A. Alonso 11-marzo-201925-abril-2021

Definir la función

   tieneCombinacionDivisible :: [Int] -> Int -> Bool

1	tieneCombinacionDivisible :: [Int] -> Int -> Bool

tal que (tieneCombinacionDivisible xs m) se verifica si existe alguna forma de combinar todos los elementos de la lista (con las operaciones suma o resta) de forma que el resultado sea divisible por m. Por ejemplo,

   tieneCombinacionDivisible [1,3,4,6] 4  ==  True
   tieneCombinacionDivisible [1,3,9]   2  ==  False

1 2	tieneCombinacionDivisible [1,3,4,6] 4 == True tieneCombinacionDivisible [1,3,9] 2 == False

En el primer ejemplo, 1 – 2 + 3 + 4 + 6 = 12 es una combinación divisible por 4. En el segundo ejemplo, las combinaciones de [1,3,9] son

   1 + 3 + 9 =  13
  -1 + 3 + 9 =  11
   1 - 3 + 9 =   7
  -1 - 3 + 9 =   5
   1 + 3 - 9 =  -5
  -1 + 3 - 9 =  -7
   1 - 3 - 9 = -11
  -1 - 3 - 9 = -13

1 + 3 + 9 = 13

-1 + 3 + 9 = 11

1 - 3 + 9 = 7

-1 - 3 + 9 = 5

1 + 3 - 9 = -5

-1 + 3 - 9 = -7

1 - 3 - 9 = -11

-1 - 3 - 9 = -13

y ninguna de las 4 es divisible por 2.

Soluciones

import Test.QuickCheck

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

tieneCombinacionDivisible :: [Int] -> Int -> Bool
tieneCombinacionDivisible xs m =
  any esDivisible (valoresCombinaciones xs)
  where esDivisible x = x `mod` m == 0

-- (valoresCombinaciones xs) es la lista de los valores de todas las
-- combinaciones de todos los elementos de la lista con las operaciones
-- suma o resta. Por ejemplo,
--    λ> valoresCombinaciones [1,3,4,6]
--    [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]
--    λ> valoresCombinaciones [1,3,-4,6]
--    [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]
valoresCombinaciones :: [Int] -> [Int]
valoresCombinaciones []     = []
valoresCombinaciones [x]    = [x,-x]
valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]
  where ys = valoresCombinaciones xs

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

tieneCombinacionDivisible2 :: [Int] -> Int -> Bool
tieneCombinacionDivisible2 xs m =
  tieneCombinacionCongruente xs m 0

-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna
-- forma de combinar todos los elementos de la lista xs (con las
-- operaciones suma o resta) de forma que el resultado sea congruente
-- con a módulo m. Por ejemplo,
--    tieneCombinacionCongruente [1,3,4,6] 4 0  ==  True
--    tieneCombinacionCongruente [1,3,4,6] 4 1  ==  False
--    tieneCombinacionCongruente [1,3,9] 2 0    ==  False
--    tieneCombinacionCongruente [1,3,9] 2 1    ==  True
tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool
tieneCombinacionCongruente []  _  _ = False
tieneCombinacionCongruente [x] m  a = (x - a) `mod` m == 0
tieneCombinacionCongruente (x:xs) m a =
  tieneCombinacionCongruente xs m (a-x) ||
  tieneCombinacionCongruente xs m (a+x)

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

-- La propiedad es
prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool
prop_tieneCombinacionDivisible xs (Positive m) =
  tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m

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

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

--    λ> (n,xs,m) = (200,[-n..n],sum [1..n]) 
--    (0.00 secs, 0 bytes)
--    λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]
--    True
--    (4.74 secs, 6,536,494,976 bytes)
--    λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]
--    True
--    (2.97 secs, 3,381,932,664 bytes)

import Test.QuickCheck

-- 1ª solución

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

tieneCombinacionDivisible :: [Int] -> Int -> Bool

tieneCombinacionDivisible xs m =

any esDivisible (valoresCombinaciones xs)

where esDivisible x = x `mod` m == 0

-- (valoresCombinaciones xs) es la lista de los valores de todas las

-- combinaciones de todos los elementos de la lista con las operaciones

-- suma o resta. Por ejemplo,

-- λ> valoresCombinaciones [1,3,4,6]

-- [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]

-- λ> valoresCombinaciones [1,3,-4,6]

-- [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]

valoresCombinaciones :: [Int] -> [Int]

valoresCombinaciones [] = []

valoresCombinaciones [x] = [x,-x]

valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]

where ys = valoresCombinaciones xs

-- 2ª solución

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

tieneCombinacionDivisible2 :: [Int] -> Int -> Bool

tieneCombinacionDivisible2 xs m =

tieneCombinacionCongruente xs m 0

-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna

-- forma de combinar todos los elementos de la lista xs (con las

-- operaciones suma o resta) de forma que el resultado sea congruente

-- con a módulo m. Por ejemplo,

-- tieneCombinacionCongruente [1,3,4,6] 4 0 == True

-- tieneCombinacionCongruente [1,3,4,6] 4 1 == False

-- tieneCombinacionCongruente [1,3,9] 2 0 == False

-- tieneCombinacionCongruente [1,3,9] 2 1 == True

tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool

tieneCombinacionCongruente [] _ _ = False

tieneCombinacionCongruente [x] m a = (x - a) `mod` m == 0

tieneCombinacionCongruente (x:xs) m a =

tieneCombinacionCongruente xs m (a-x) ||

tieneCombinacionCongruente xs m (a+x)

-- Equivalencia

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

-- La propiedad es

prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool

prop_tieneCombinacionDivisible xs (Positive m) =

tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> (n,xs,m) = (200,[-n..n],sum [1..n])

-- (0.00 secs, 0 bytes)

-- λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]

-- True

-- (4.74 secs, 6,536,494,976 bytes)

-- λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]

-- True

-- (2.97 secs, 3,381,932,664 bytes)

Pensamiento

El que espera desespera,
dice la voz popular.
¡Qué verdad tan verdadera!
La verdad es lo que es,
y sigue siendo verdad
aunque se piense al revés.

Antonio Machado

Camino de máxima suma en una matriz

PorJosé A. Alonso 8-marzo-201925-abril-2021

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El camino de máxima suma es el segundo (1, 7, 12, 8, 4, 9) que tiene una suma de 41.

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

1	caminoMaxSuma :: Matrix Int -> [Int]

tal que (caminoMaxSuma m) es un camino de máxima suma en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [1,7,12,8,4,9]
   λ> sum (caminoMaxSuma (fromList 800 800 [1..]))
   766721999

λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])

[1,7,12,8,4,9]

λ> sum (caminoMaxSuma (fromList 800 800 [1..]))

766721999

Soluciones

import Data.Matrix
import Test.QuickCheck

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

caminoMaxSuma1 :: Matrix Int -> [Int]
caminoMaxSuma1 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos1 m
        k  = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]

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

caminoMaxSuma2 :: Matrix Int -> [Int]
caminoMaxSuma2 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos2 m
        k  = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  

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

caminoMaxSuma3 :: Matrix Int -> [Int]
caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))
  where nf = nrows m
        nc = ncols m
        q  = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])
caminoMaxSumaAux m = q 
  where
    nf = nrows m
    nc = ncols m
    q  = matrix nf nc f
      where
        f (1,1) = (m!(1,1),[m!(1,1)])
        f (1,j) = (k + m!(1,j), m!(1,j):xs)
          where (k,xs) = q!(1,j-1)
        f (i,1) = (k + m!(i,1), m!(i,1):xs)
          where (k,xs) = q!(i-1,1)        
        f (i,j) | k1 > k2   = (k1 + m!(i,j), m!(i,j):xs)
                | otherwise = (k2 + m!(i,j), m!(i,j):ys)
          where (k1,xs) = q!(i,j-1)
                (k2,ys) = q!(i-1,j)

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

-- El generador es
instance Arbitrary a => Arbitrary (Matrix a) where
  arbitrary =  do
    m <- choose (1,7)
    n <- choose (1,7)
    xs <- Test.QuickCheck.vector (n*m)
    return (fromList m n xs)


-- Por ejemplo,
--    λ> sample' (arbitrary :: Gen (Matrix Int))
--    [( 0 )
--     ( 0 )
--     ( 0 )
--     ( 0 )
--    ,(  1  2 )
--     ( -1  1 )
--     ( -1 -2 )
--     (  1 -1 )
--     (  1  0 )
--     (  2  0 )
--     (  2 -2 )
--    ,( -4  4 -2 )
--     ( -2  0 -2 )
--     (  0 -1 -2 )
--     ( -4 -1  2 )
--    ,( -2  7 -3  1 -5 -3  5 )
--     (  0  2  7 -1 -5  7 -6 )
--     (  1  7 -8  1  6 -7  5 )
--     ( -4  7 -2 -7 -5  5 -8 )
--    ...

-- La propiedad es
prop_caminoMaxSuma :: Matrix Int -> Bool
prop_caminoMaxSuma m =
  x1 == x2 && x2 == x3
  where x1 = sum (caminoMaxSuma1 m)
        x2 = sum (caminoMaxSuma2 m)
        x3 = sum (caminoMaxSuma1 m)

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


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

--    λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))
--    21
--    (10.00 secs, 1,510,120,328 bytes)
--    λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))
--    21
--    (3.84 secs, 745,918,544 bytes)
--    λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))
--    21
--    (0.01 secs, 0 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

import Data.Matrix

import Test.QuickCheck

-- 1ª definición

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

caminoMaxSuma1 :: Matrix Int -> [Int]

caminoMaxSuma1 m =

head [c | c <- cs, sum c == k]

where cs = caminos1 m

k = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]

caminos1 m =

map reverse (caminos1Aux m (nf,nc))

where nf = nrows m

nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p

-- desde la posición (1,1) hasta la posición x. Por ejemplo,

caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]

caminos1Aux m (1,1) = [[m!(1,1)]]

caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]

caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]

caminos1Aux m (i,j) = [m!(i,j) : xs

| xs <- caminos1Aux m (i,j-1) ++

caminos1Aux m (i-1,j)]

-- 2ª definición

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

caminoMaxSuma2 :: Matrix Int -> [Int]

caminoMaxSuma2 m =

head [c | c <- cs, sum c == k]

where cs = caminos2 m

k = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]

caminos2 m =

map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]

matrizCaminos m = q

where

q = matrix (nrows m) (ncols m) f

f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]

f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]

f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]

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

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

caminoMaxSuma3 :: Matrix Int -> [Int]

caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))

where nf = nrows m

nc = ncols m

q = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])

caminoMaxSumaAux m = q

where

nf = nrows m

nc = ncols m

q = matrix nf nc f

where

f (1,1) = (m!(1,1),[m!(1,1)])

f (1,j) = (k + m!(1,j), m!(1,j):xs)

where (k,xs) = q!(1,j-1)

f (i,1) = (k + m!(i,1), m!(i,1):xs)

where (k,xs) = q!(i-1,1)

f (i,j) | k1 > k2 = (k1 + m!(i,j), m!(i,j):xs)

| otherwise = (k2 + m!(i,j), m!(i,j):ys)

where (k1,xs) = q!(i,j-1)

(k2,ys) = q!(i-1,j)

-- Equivalencia de las definiciones

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

-- El generador es

instance Arbitrary a => Arbitrary (Matrix a) where

arbitrary = do

m <- choose (1,7)

n <- choose (1,7)

xs <- Test.QuickCheck.vector (n*m)

return (fromList m n xs)

-- Por ejemplo,

-- λ> sample' (arbitrary :: Gen (Matrix Int))

-- [( 0 )

-- ( 0 )

-- ,( 1 2 )

-- ( -1 1 )

-- ( -1 -2 )

-- ( 1 -1 )

-- ( 1 0 )

-- ( 2 0 )

-- ( 2 -2 )

-- ,( -4 4 -2 )

-- ( -2 0 -2 )

-- ( 0 -1 -2 )

-- ( -4 -1 2 )

-- ,( -2 7 -3 1 -5 -3 5 )

-- ( 0 2 7 -1 -5 7 -6 )

-- ( 1 7 -8 1 6 -7 5 )

-- ( -4 7 -2 -7 -5 5 -8 )

-- ...

-- La propiedad es

prop_caminoMaxSuma :: Matrix Int -> Bool

prop_caminoMaxSuma m =

x1 == x2 && x2 == x3

where x1 = sum (caminoMaxSuma1 m)

x2 = sum (caminoMaxSuma2 m)

x3 = sum (caminoMaxSuma1 m)

-- La comprobación es

-- λ> quickCheck prop_caminoMaxSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- -------------------------

-- λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))

-- 21

-- (10.00 secs, 1,510,120,328 bytes)

-- λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))

-- 21

-- (3.84 secs, 745,918,544 bytes)

-- λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))

-- 21

-- (0.01 secs, 0 bytes)

Pensamiento

Caminante, no hay camino,
sino estelas en la mar.

Antonio Machado

Suma de segmentos iniciales

PorJosé A. Alonso 7-marzo-201925-abril-2021

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

1	sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales3 [1..3*10^6]  ==  4500004500001000000

1 2	sumaSegmentosIniciales [3,1,2,5] == 24 sumaSegmentosIniciales3 [1..3*10^6] == 4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

1	sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

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

Soluciones

import Data.List (genericLength, genericReplicate)
import Test.QuickCheck

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

sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]

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

sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs

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

sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)

-- Comprobación de la equivalencia
-- ===============================

-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]

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

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

--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)

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

-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2

-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

import Data.List (genericLength, genericReplicate)

import Test.QuickCheck

-- 1ª solución

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

sumaSegmentosIniciales :: [Integer] -> Integer

sumaSegmentosIniciales xs =

sum [sum (take k xs) | k <- [1.. length xs]]

-- 2ª solución

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

sumaSegmentosIniciales2 :: [Integer] -> Integer

sumaSegmentosIniciales2 xs =

sum (zipWith (*) [n,n-1..1] xs)

where n = genericLength xs

-- 3ª solución

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

sumaSegmentosIniciales3 :: [Integer] -> Integer

sumaSegmentosIniciales3 xs =

sum (scanl1 (+) xs)

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool

prop_sumaSegmentosInicialesEquiv xs =

all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2

, sumaSegmentosIniciales3]]

-- La comprobación es

-- λ> quickCheck prop_sumaSegmentosInicialesEquiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sumaSegmentosIniciales [1..10^4]

-- 166716670000

-- (2.42 secs, 7,377,926,824 bytes)

-- λ> sumaSegmentosIniciales2 [1..10^4]

-- 166716670000

-- (0.01 secs, 4,855,176 bytes)

-- λ> sumaSegmentosIniciales2 [1..3*10^6]

-- 4500004500001000000

-- (2.68 secs, 1,424,404,168 bytes)

-- λ> sumaSegmentosIniciales3 [1..3*10^6]

-- 4500004500001000000

-- (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumaSegmentosIniciales :: Positive Integer -> Bool

prop_sumaSegmentosIniciales (Positive n) =

sumaSegmentosIniciales3 (genericReplicate n 1) ==

n * (n + 1) `div` 2

-- La compronación es

-- λ> quickCheck prop_sumaSegmentosIniciales

-- +++ OK, passed 100 tests.

Pensamiento

Al andar se hace camino,
y al volver la vista atrás
se ve la senda que nunca
se ha de volver a pisar.

Antonio Machado

Números como suma de sus dígitos

PorJosé A. Alonso 6-marzo-201925-abril-2021

El número 23 se puede escribir de 4 formas como suma de sus dígitos

   2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3
   2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3
   2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3
   2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3

2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3

2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

La de menor número de sumando es la última, que tiene 8 sumandos.

Definir las funciones

   minimoSumandosDigitos        :: Integer -> Integer
   graficaMinimoSumandosDigitos :: Integer -> IO ()

1 2	minimoSumandosDigitos :: Integer -> Integer graficaMinimoSumandosDigitos :: Integer -> IO ()

tales que

(minimoSumandosDigitos n) es el menor número de dígitos de n cuya suma es n. Por ejemplo,

     minimoSumandosDigitos 23    ==  8
     minimoSumandosDigitos 232   ==  78
     minimoSumandosDigitos 2323  ==  775
     map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

minimoSumandosDigitos 23 == 8

minimoSumandosDigitos 232 == 78

minimoSumandosDigitos 2323 == 775

map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

(graficaMinimoSumandosDigitos n) dibuja la gráfica de (minimoSumandosDigitos k) par los k primeros números naturales. Por ejemplo, (graficaMinimoSumandosDigitos 300) dibuja

Soluciones

import Data.List (nub, genericLength, sort)
import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer
minimoSumandosDigitos n =
  minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,
--    digitos 2032  ==  [2,3]
digitos :: Integer -> [Integer]
digitos n =
  nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de
-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por
-- ejemplo, 
--    minimoSumandos [7,2,4] 11  ==  2
minimoSumandos :: [Integer] -> Integer -> Integer
minimoSumandos xs n =
  minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros
-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,  
--    sumas [7,2,4] 11  ==  [[7,2,2],[7,4]]
sumas :: [Integer] -> Integer -> [[Integer]]
sumas [] 0 = [[]]
sumas [] _ = []
sumas (x:xs) n
  | x <= n    = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n
  | otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()
graficaMinimoSumandosDigitos n =
  plotList [ Key Nothing
           , PNG "Numero_como_suma_de_sus_digitos.png"
           ]
           [minimoSumandosDigitos k | k <- [0..n-1]]

import Data.List (nub, genericLength, sort)

import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer

minimoSumandosDigitos n =

minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,

-- digitos 2032 == [2,3]

digitos :: Integer -> [Integer]

digitos n =

nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de

-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por

-- ejemplo,

-- minimoSumandos [7,2,4] 11 == 2

minimoSumandos :: [Integer] -> Integer -> Integer

minimoSumandos xs n =

minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros

-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,

-- sumas [7,2,4] 11 == [[7,2,2],[7,4]]

sumas :: [Integer] -> Integer -> [[Integer]]

sumas [] 0 = [[]]

sumas [] _ = []

sumas (x:xs) n

| x <= n = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n

| otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()

graficaMinimoSumandosDigitos n =

plotList [ Key Nothing

, PNG "Numero_como_suma_de_sus_digitos.png"

]

[minimoSumandosDigitos k | k <- [0..n-1]]

Pensamiento

Caminante, son tus huellas
el camino, y nada más;
caminante no hay camino,
se hace camino al andar.

Antonio Machado

Hojas con caminos no decrecientes

PorJosé A. Alonso 4-marzo-201925-abril-2021

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol = N Int [Arbol]
     deriving Show

1 2	data Arbol = N Int [Arbol] deriving Show

Por ejemplo, los árboles

         1             1             1  
        /  \          / \           / \ 
       /    \        8   3         8   3
      2      6          /|\       /|\  |
     / \    / \        4 2 6     4 5 6 2
    4   5  5   7

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 6 /|\ /|\ |

/ \ / \ 4 2 6 4 5 6 2

4 5 5 7

se representan por

   ej1, ej2, ej3 :: Arbol
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]
   ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]
   ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]

ej1, ej2, ej3 :: Arbol

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

1	hojasEnNoDecreciente :: Arbol -> [Int]

tal que (hojasEnNoDecreciente a) es el conjunto de las hojas de a que se encuentran en alguna rama no decreciente. Por ejemplo,

   hojasEnNoDecreciente ej1  ==  [4,5,7]
   hojasEnNoDecreciente ej2  ==  [4,6,8]
   hojasEnNoDecreciente ej3  ==  []

hojasEnNoDecreciente ej1 == [4,5,7]

hojasEnNoDecreciente ej2 == [4,6,8]

hojasEnNoDecreciente ej3 == []

Soluciones

import Data.List (sort, nub)

data Arbol = N Int [Arbol]
  deriving Show
           
ej1, ej2, ej3 :: Arbol
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]

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

hojasEnNoDecreciente :: Arbol -> [Int]
hojasEnNoDecreciente a =
  sort (nub (map last (ramasNoDecrecientes a)))

--    ramasNoDecrecientes ej1  ==  [[1,2,4],[1,2,5],[1,6,7]]
--    ramasNoDecrecientes ej2  ==  [[1,8],[1,3,4],[1,3,6]]
--    ramasNoDecrecientes ej3  ==  []
ramasNoDecrecientes :: Arbol -> [[Int]]
ramasNoDecrecientes a =
  filter esNoDecreciente (ramas a)

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas ej1
--    [[1,2,4],[1,2,5],[1,6,5],[1,6,7]]
--    λ> ramas ej2
--    [[1,8],[1,3,4],[1,3,2],[1,3,6]]
--    λ> ramas ej3
--    [[1,8,4],[1,8,5],[1,8,6],[1,3,2]]
ramas :: Arbol -> [[Int]]
ramas (N x []) = [[x]]
ramas (N x as) = map (x:) (concatMap ramas as)

-- (esNoDecreciente xs) se verifica si la lista xs es no
-- decreciente. Por ejemplo, 
--    esNoDecreciente [1,3,3,5]  ==  True
--    esNoDecreciente [1,3,5,3]  ==  False
esNoDecreciente :: [Int] -> Bool
esNoDecreciente xs =
  and (zipWith (<=) xs (tail xs))

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

--    hojasEnNoDecreciente ej1  ==  [4,5,7]
--    hojasEnNoDecreciente ej2  ==  [4,6,8]
--    hojasEnNoDecreciente ej3  ==  []
hojasEnNoDecreciente2 :: Arbol -> [Int]
hojasEnNoDecreciente2 = sort . nub . aux
  where
    aux (N x []) = [x]
    aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

import Data.List (sort, nub)

data Arbol = N Int [Arbol]

deriving Show

ej1, ej2, ej3 :: Arbol

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]

-- 1ª solución

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

hojasEnNoDecreciente :: Arbol -> [Int]

hojasEnNoDecreciente a =

sort (nub (map last (ramasNoDecrecientes a)))

-- ramasNoDecrecientes ej1 == [[1,2,4],[1,2,5],[1,6,7]]

-- ramasNoDecrecientes ej2 == [[1,8],[1,3,4],[1,3,6]]

-- ramasNoDecrecientes ej3 == []

ramasNoDecrecientes :: Arbol -> [[Int]]

ramasNoDecrecientes a =

filter esNoDecreciente (ramas a)

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

-- λ> ramas ej1

-- [[1,2,4],[1,2,5],[1,6,5],[1,6,7]]

-- λ> ramas ej2

-- [[1,8],[1,3,4],[1,3,2],[1,3,6]]

-- λ> ramas ej3

-- [[1,8,4],[1,8,5],[1,8,6],[1,3,2]]

ramas :: Arbol -> [[Int]]

ramas (N x []) = [[x]]

ramas (N x as) = map (x:) (concatMap ramas as)

-- (esNoDecreciente xs) se verifica si la lista xs es no

-- decreciente. Por ejemplo,

-- esNoDecreciente [1,3,3,5] == True

-- esNoDecreciente [1,3,5,3] == False

esNoDecreciente :: [Int] -> Bool

esNoDecreciente xs =

and (zipWith (<=) xs (tail xs))

-- 2ª solución

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

-- hojasEnNoDecreciente ej1 == [4,5,7]

-- hojasEnNoDecreciente ej2 == [4,6,8]

-- hojasEnNoDecreciente ej3 == []

hojasEnNoDecreciente2 :: Arbol -> [Int]

hojasEnNoDecreciente2 = sort . nub . aux

where

aux (N x []) = [x]

aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

Pensamiento

Para dialogar,
preguntad, primero;
después … escuchad.

Antonio Machado

Número de descomposiciones en sumas de cuatro cuadrados

PorJosé A. Alonso 1-marzo-201926-marzo-2022

Definir la función

   nDescomposiciones       :: Int -> Int
   graficaDescomposiciones :: Int -> IO ()

1 2	nDescomposiciones :: Int -> Int graficaDescomposiciones :: Int -> IO ()

tales que

(nDescomposiciones x) es el número de listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.

     nDescomposiciones 4      ==  1
     nDescomposiciones 5      ==  0
     nDescomposiciones 7      ==  4
     nDescomposiciones 10     ==  6
     nDescomposiciones 15     ==  12
     nDescomposiciones 50000  ==  5682

nDescomposiciones 4 == 1

nDescomposiciones 5 == 0

nDescomposiciones 7 == 4

nDescomposiciones 10 == 6

nDescomposiciones 15 == 12

nDescomposiciones 50000 == 5682

(graficaDescomposiciones n) dibuja la gráfica del número de descomposiciones de los n primeros números naturales. Por ejemplo, (graficaDescomposiciones 500) dibuja

Soluciones

import Data.Array
import Graphics.Gnuplot.Simple
import Test.QuickCheck

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

nDescomposiciones :: Int -> Int
nDescomposiciones = length . descomposiciones

-- (descomposiciones x) es la lista de las listas de los cuadrados de
-- cuatro números enteros positivos cuya suma es x. Por  ejemplo. 
--    λ> descomposiciones 4
--    [[1,1,1,1]]
--    λ> descomposiciones 5
--    []
--    λ> descomposiciones 7
--    [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
--    λ> descomposiciones 10
--    [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
--    λ> descomposiciones 15
--    [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
--     [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]

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

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

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

nDescomposiciones2 :: Int -> Int
nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]

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

nDescomposiciones3 :: Int -> Int
nDescomposiciones3 x = aux x 4
  where
    aux 0 1 = 0
    aux 1 1 = 1
    aux 2 1 = 0
    aux 3 1 = 0
    aux y 1 | esCuadrado y = 1
            | otherwise    = 0
    aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]

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

nDescomposiciones4 :: Int -> Int
nDescomposiciones4 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = 0
    f 1 1 = 1
    f 2 1 = 0
    f 3 1 = 0
    f i 1 | esCuadrado i = 1
          | otherwise    = 0
    f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_nDescomposiciones :: Positive Int -> Bool
prop_nDescomposiciones (Positive x) =
  all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2
                                           , nDescomposiciones3
                                           , nDescomposiciones4]]

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

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

--    λ> nDescomposiciones 20000
--    1068
--    (3.69 secs, 3,307,250,128 bytes)
--    λ> nDescomposiciones2 20000
--    1068
--    (0.72 secs, 678,419,328 bytes)
--    λ> nDescomposiciones3 20000
--    1068
--    (3.94 secs, 3,485,725,552 bytes)
--    λ> nDescomposiciones4 20000
--    1068
--    (0.74 secs, 716,022,456 bytes)
--    
--    λ> nDescomposiciones2 50000
--    5682
--    (2.64 secs, 2,444,206,000 bytes)
--    λ> nDescomposiciones4 50000
--    5682
--    (2.77 secs, 2,582,443,448 bytes)

-- Definición de graficaDescomposiciones
-- =====================================

graficaDescomposiciones :: Int -> IO ()
graficaDescomposiciones n =
  plotList [ Key Nothing
           , PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")
           ]
           (map nDescomposiciones3 [0..n])

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

import Data.Array

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª solución

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

nDescomposiciones :: Int -> Int

nDescomposiciones = length . descomposiciones

-- (descomposiciones x) es la lista de las listas de los cuadrados de

-- cuatro números enteros positivos cuya suma es x. Por ejemplo.

-- λ> descomposiciones 4

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

-- λ> descomposiciones 5

-- []

-- λ> descomposiciones 7

-- [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]

-- λ> descomposiciones 10

-- [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]

-- λ> descomposiciones 15

-- [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],

-- [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]

descomposiciones :: Int -> [[Int]]

descomposiciones x = aux x 4

where

aux 0 1 = []

aux 1 1 = [[1]]

aux 2 1 = []

aux 3 1 = []

aux y 1 | esCuadrado y = [[y]]

| otherwise = []

aux y n = [x^2 : zs | x <- [1..raizEntera y]

, zs <- aux (y - x^2) (n-1)]

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Int -> Bool

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

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

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Int -> Int

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

nDescomposiciones2 :: Int -> Int

nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]

descomposiciones2 x = a ! (x,4)

where

a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]

f 0 1 = []

f 1 1 = [[1]]

f 2 1 = []

f 3 1 = []

f i 1 | esCuadrado i = [[i]]

| otherwise = []

f i j = [x^2 : zs | x <- [1..raizEntera i]

, zs <- a ! (i - x^2,j-1)]

-- 3ª solución

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

nDescomposiciones3 :: Int -> Int

nDescomposiciones3 x = aux x 4

where

aux 0 1 = 0

aux 1 1 = 1

aux 2 1 = 0

aux 3 1 = 0

aux y 1 | esCuadrado y = 1

| otherwise = 0

aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]

-- 4ª solución

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

nDescomposiciones4 :: Int -> Int

nDescomposiciones4 x = a ! (x,4)

where

a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]

f 0 1 = 0

f 1 1 = 1

f 2 1 = 0

f 3 1 = 0

f i 1 | esCuadrado i = 1

| otherwise = 0

f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_nDescomposiciones :: Positive Int -> Bool

prop_nDescomposiciones (Positive x) =

all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2

, nDescomposiciones3

, nDescomposiciones4]]

-- La comprobación es

-- λ> quickCheck prop_nDescomposiciones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> nDescomposiciones 20000

-- 1068

-- (3.69 secs, 3,307,250,128 bytes)

-- λ> nDescomposiciones2 20000

-- 1068

-- (0.72 secs, 678,419,328 bytes)

-- λ> nDescomposiciones3 20000

-- 1068

-- (3.94 secs, 3,485,725,552 bytes)

-- λ> nDescomposiciones4 20000

-- 1068

-- (0.74 secs, 716,022,456 bytes)

-- λ> nDescomposiciones2 50000

-- 5682

-- (2.64 secs, 2,444,206,000 bytes)

-- λ> nDescomposiciones4 50000

-- 5682

-- (2.77 secs, 2,582,443,448 bytes)

-- Definición de graficaDescomposiciones

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

graficaDescomposiciones :: Int -> IO ()

graficaDescomposiciones n =

plotList [ Key Nothing

, PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")

]

(map nDescomposiciones3 [0..n])

Pensamiento

Ya habrá cigüeñas al sol,
mirando la tarde roja,
entre Moncayo y Urbión.

Antonio Machado

Descomposiciones en sumas de cuatro cuadrados

PorJosé A. Alonso 28-febrero-20197-marzo-2019

Definir la función

   descomposiciones :: Int -> [[Int]]

1	descomposiciones :: Int -> [[Int]]

tal que (descomposiciones x) es la lista de las listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.

   λ> descomposiciones 4
   [[1,1,1,1]]
   λ> descomposiciones 5
   []
   λ> descomposiciones 7
   [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
   λ> descomposiciones 10
   [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
   λ> descomposiciones 15
   [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
    [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
   λ> length (descomposiciones 50000)
   5682

λ> descomposiciones 4

[[1,1,1,1]]

λ> descomposiciones 5

[]

λ> descomposiciones 7

[[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]

λ> descomposiciones 10

[[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]

λ> descomposiciones 15

[[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],

[4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]

λ> length (descomposiciones 50000)

5682

Soluciones

import Data.Array
import Test.QuickCheck

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

descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]

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

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

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

descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_descomposiciones :: Positive Int -> Bool
prop_descomposiciones (Positive x) =
  descomposiciones x == descomposiciones2 x

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

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

-- La comparación es
--    λ> length (descomposiciones (2*10^4))
--    1068
--    (3.70 secs, 3,307,251,704 bytes)
--    λ> length (descomposiciones2 (2*10^4))
--    1068
--    (0.72 secs, 678,416,144 bytes)

import Data.Array

import Test.QuickCheck

-- 1ª definición

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

descomposiciones :: Int -> [[Int]]

descomposiciones x = aux x 4

where

aux 0 1 = []

aux 1 1 = [[1]]

aux 2 1 = []

aux 3 1 = []

aux y 1 | esCuadrado y = [[y]]

| otherwise = []

aux y n = [x^2 : zs | x <- [1..raizEntera y]

, zs <- aux (y - x^2) (n-1)]

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Int -> Bool

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

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

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Int -> Int

raizEntera = floor . sqrt . fromIntegral

-- 2ª definición

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

descomposiciones2 :: Int -> [[Int]]

descomposiciones2 x = a ! (x,4)

where

a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]

f 0 1 = []

f 1 1 = [[1]]

f 2 1 = []

f 3 1 = []

f i 1 | esCuadrado i = [[i]]

| otherwise = []

f i j = [x^2 : zs | x <- [1..raizEntera i]

, zs <- a ! (i - x^2,j-1)]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_descomposiciones :: Positive Int -> Bool

prop_descomposiciones (Positive x) =

descomposiciones x == descomposiciones2 x

-- La comprobación es

-- λ> quickCheck prop_descomposiciones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (descomposiciones (2*10^4))

-- 1068

-- (3.70 secs, 3,307,251,704 bytes)

-- λ> length (descomposiciones2 (2*10^4))

-- 1068

-- (0.72 secs, 678,416,144 bytes)

Pensamiento

No extrañéis, dulces amigos,
que esté mi frente arrugada;
yo vivo en paz con los hombres
y en guerra con mis entrañas.

Antonio Machado

Número de particiones de un conjunto

PorJosé A. Alonso 27-febrero-20196-marzo-2019

Una partición de un conjunto A es un conjunto de subconjuntos no vacíos de A, disjuntos dos a dos y cuya unión es A. Por ejemplo, el conjunto {1, 2, 3} tiene exactamente 5 particiones:

   {{1}, {2}, {3}}
   {{1,2}, {3}}
   {{1,3}, {2}}
   {{1}, {2,3}}
   {{1,2,3}}

{{1}, {2}, {3}}

{{1,2}, {3}}

{{1,3}, {2}}

{{1}, {2,3}}

Definir la función

   nParticiones :: [a] -> Integer

1	nParticiones :: [a] -> Integer

tal que (nParticiones xs) es el número de particiones de xs. Por ejemplo,

   nParticiones [1,2]                     ==  2
   nParticiones [1,2,3]                   ==  5
   nParticiones "abcd"                    ==  15
   length (show (nParticiones [1..500]))  ==  844

nParticiones [1,2] == 2

nParticiones [1,2,3] == 5

nParticiones "abcd" == 15

length (show (nParticiones [1..500])) == 844

Soluciones

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

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

nParticiones :: [a] -> Integer
nParticiones xs =
  genericLength (particiones xs)

-- (particiones xs) es el conjunto de las particiones de xs. Por
-- ejemplo, 
--    λ> particiones [1,2]
--    [[[1,2]],[[1],[2]]]
--    λ> particiones [1,2,3]
--    [[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]
particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones xs =
  concat [particionesFijas xs k | k <- [0..length xs]]

-- (particionesFijas xs k) es el conjunto de las particiones de xs en k
-- subconjuntos. Por ejemplo,
--    particionesFijas [1,2,3] 0  ==  []
--    particionesFijas [1,2,3] 1  ==  [[[1,2,3]]]
--    particionesFijas [1,2,3] 2  ==  [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]
--    particionesFijas [1,2,3] 3  ==  [[[1],[2],[3]]]
--    particionesFijas [1,2,3] 4  ==  []
particionesFijas :: [a] -> Int -> [[[a]]]
particionesFijas [] _ = []
particionesFijas xs 1 = [[xs]]
particionesFijas (x:xs) k =
   [[x]:ys | ys <- particionesFijas xs (k-1)] ++
   concat [inserta x ys | ys <- particionesFijas xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- elementos de yss. Por ejemplo, 
--    λ> inserta 1 [[2,3],[4],[5,6,7]]
--    [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

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

nParticiones2 :: [a] -> Integer
nParticiones2 xs = sum [nParticionesFijas n k | k <- [0..n]]
  where n = genericLength xs

-- nPparticionesFijas n k) es el número de las particiones de un
-- conjunto con n elementos en k subconjuntos. Por ejemplo,
--    nParticionesFijas 3 0  ==  0
--    nParticionesFijas 3 1  ==  1
--    nParticionesFijas 3 2  ==  3
--    nParticionesFijas 3 3  ==  1
--    nParticionesFijas 3 4  ==  0
nParticionesFijas :: Integer -> Integer -> Integer
nParticionesFijas 0 0 = 1
nParticionesFijas 0 _ = 0
nParticionesFijas n 1 = 1
nParticionesFijas n k = nParticionesFijas (n-1) (k-1) + k * nParticionesFijas (n-1) k

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

nParticiones3 :: [a] -> Integer
nParticiones3 xs = sum [a ! (n,k) | k <- [0..n]]
  where n = genericLength xs
        a = matrizNParticiones n

-- (matrizNParticiones n) es la matriz de dimensión ((0,0),(n,n)) que en
-- la posición (i,j) tiene el número de particiones de un conjunto de i
-- elementos en j subconjuntos. Por ejemplo,
--    λ> matrizNParticiones 3
--    array ((0,0),(3,3))
--          [((0,0),0),((0,1),0),((0,2),0),((0,3),0),
--           ((1,0),0),((1,1),1),((1,2),0),((1,3),0),
--           ((2,0),0),((2,1),1),((2,2),1),((2,3),0),
--           ((3,0),0),((3,1),1),((3,2),3),((3,3),1)]
--    λ> matrizNParticiones 4
--    array ((0,0),(4,4))
--          [((0,0),0),((0,1),0),((0,2),0),((0,3),0),((0,4),0),
--           ((1,0),0),((1,1),1),((1,2),0),((1,3),0),((1,4),0),
--           ((2,0),0),((2,1),1),((2,2),1),((2,3),0),((2,4),0),
--           ((3,0),0),((3,1),1),((3,2),3),((3,3),1),((3,4),0),
--           ((4,0),0),((4,1),1),((4,2),7),((4,3),6),((4,4),1)]
matrizNParticiones :: Integer -> Array (Integer,Integer) Integer
matrizNParticiones n = a 
  where
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = 1
    f 0 _ = 0
    f _ 0 = 0
    f _ 1 = 1
    f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

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

nParticiones4 :: [a] -> Integer
nParticiones4 xs = sum [a ! (n,k) | k <- [0..n]]
  where
    n = genericLength xs
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = 1
    f 0 _ = 0
    f _ 0 = 0
    f _ 1 = 1
    f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

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

--    λ> nParticiones [1..11]
--    678570
--    (3.77 secs, 705,537,480 bytes)
--    λ> nParticiones2 [1..11]
--    678570
--    (0.07 secs, 6,656,584 bytes)
--    λ> nParticiones3 [1..11]
--    678570
--    (0.01 secs, 262,176 bytes)
--    λ> nParticiones4 [1..11]
--    678570
--    (0.01 secs, 262,264 bytes)
--    
--    λ> nParticiones2 [1..16]
--    10480142147
--    (2.24 secs, 289,774,408 bytes)
--    λ> nParticiones3 [1..16]
--    10480142147
--    (0.01 secs, 437,688 bytes)
--    λ> nParticiones4 [1..16]
--    10480142147
--    (0.01 secs, 437,688 bytes)
--    
--    λ> length (show (nParticiones3 [1..500]))
--    844
--    (2.23 secs, 357,169,528 bytes)
--    λ> length (show (nParticiones4 [1..500]))
--    844
--    (2.20 secs, 357,172,680 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

import Data.List ( genericLength

)

import Data.Array ( Array

, (!)

, array

)

-- 1ª definición

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

nParticiones :: [a] -> Integer

nParticiones xs =

genericLength (particiones xs)

-- (particiones xs) es el conjunto de las particiones de xs. Por

-- ejemplo,

-- λ> particiones [1,2]

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

-- λ> particiones [1,2,3]

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

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones xs =

concat [particionesFijas xs k | k <- [0..length xs]]

-- (particionesFijas xs k) es el conjunto de las particiones de xs en k

-- subconjuntos. Por ejemplo,

-- particionesFijas [1,2,3] 0 == []

-- particionesFijas [1,2,3] 1 == [[[1,2,3]]]

-- particionesFijas [1,2,3] 2 == [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]

-- particionesFijas [1,2,3] 3 == [[[1],[2],[3]]]

-- particionesFijas [1,2,3] 4 == []

particionesFijas :: [a] -> Int -> [[[a]]]

particionesFijas [] _ = []

particionesFijas xs 1 = [[xs]]

particionesFijas (x:xs) k =

[[x]:ys | ys <- particionesFijas xs (k-1)] ++

concat [inserta x ys | ys <- particionesFijas xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- elementos de yss. Por ejemplo,

-- λ> inserta 1 [[2,3],[4],[5,6,7]]

-- [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- 2ª definición

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

nParticiones2 :: [a] -> Integer

nParticiones2 xs = sum [nParticionesFijas n k | k <- [0..n]]

where n = genericLength xs

-- nPparticionesFijas n k) es el número de las particiones de un

-- conjunto con n elementos en k subconjuntos. Por ejemplo,

-- nParticionesFijas 3 0 == 0

-- nParticionesFijas 3 1 == 1

-- nParticionesFijas 3 2 == 3

-- nParticionesFijas 3 3 == 1

-- nParticionesFijas 3 4 == 0

nParticionesFijas :: Integer -> Integer -> Integer

nParticionesFijas 0 0 = 1

nParticionesFijas 0 _ = 0

nParticionesFijas n 1 = 1

nParticionesFijas n k = nParticionesFijas (n-1) (k-1) + k * nParticionesFijas (n-1) k

-- 3ª definición

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

nParticiones3 :: [a] -> Integer

nParticiones3 xs = sum [a ! (n,k) | k <- [0..n]]

where n = genericLength xs

a = matrizNParticiones n

-- (matrizNParticiones n) es la matriz de dimensión ((0,0),(n,n)) que en

-- la posición (i,j) tiene el número de particiones de un conjunto de i

-- elementos en j subconjuntos. Por ejemplo,

-- λ> matrizNParticiones 3

-- array ((0,0),(3,3))

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

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

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

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

-- λ> matrizNParticiones 4

-- array ((0,0),(4,4))

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

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

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

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

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

matrizNParticiones :: Integer -> Array (Integer,Integer) Integer

matrizNParticiones n = a

where

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

f 0 0 = 1

f 0 _ = 0

f _ 0 = 0

f _ 1 = 1

f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

-- 4ª definición

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

nParticiones4 :: [a] -> Integer

nParticiones4 xs = sum [a ! (n,k) | k <- [0..n]]

where

n = genericLength xs

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

f 0 0 = 1

f 0 _ = 0

f _ 0 = 0

f _ 1 = 1

f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

-- Comparación de eficiencia

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

-- λ> nParticiones [1..11]

-- 678570

-- (3.77 secs, 705,537,480 bytes)

-- λ> nParticiones2 [1..11]

-- 678570

-- (0.07 secs, 6,656,584 bytes)

-- λ> nParticiones3 [1..11]

-- 678570

-- (0.01 secs, 262,176 bytes)

-- λ> nParticiones4 [1..11]

-- 678570

-- (0.01 secs, 262,264 bytes)

-- λ> nParticiones2 [1..16]

-- 10480142147

-- (2.24 secs, 289,774,408 bytes)

-- λ> nParticiones3 [1..16]

-- 10480142147

-- (0.01 secs, 437,688 bytes)

-- λ> nParticiones4 [1..16]

-- 10480142147

-- (0.01 secs, 437,688 bytes)

-- λ> length (show (nParticiones3 [1..500]))

-- 844

-- (2.23 secs, 357,169,528 bytes)

-- λ> length (show (nParticiones4 [1..500]))

-- 844

-- (2.20 secs, 357,172,680 bytes)

Pensamiento

Yo he visto garras fieras en las pulidas manos;
conozco grajos mélicos y líricos marranos …
El más truhán se lleva la mano al corazón,
y el bruto más espeso se carga de razón.

Antonio Machado

Particiones de un conjunto

PorJosé A. Alonso 26-febrero-20195-marzo-2019

Una partición de un conjunto A es un conjunto de subconjuntos no vacíos de A, disjuntos dos a dos y cuya unión es A. Por ejemplo, el conjunto {1, 2, 3} tiene exactamente 5 particiones:

   {{1}, {2}, {3}}
   {{1,2}, {3}}
   {{1,3}, {2}}
   {{1}, {2,3}}
   {{1,2,3}}

{{1}, {2}, {3}}

{{1,2}, {3}}

{{1,3}, {2}}

{{1}, {2,3}}

Definir la función

   particiones :: [a] -> [[[a]]]

1	particiones :: [a] -> [[[a]]]

tal que (particiones xs) es el conjunto de las particiones de xs. Por ejemplo,

   λ> particiones [1,2]
   [[[1,2]],[[1],[2]]]
   λ> particiones [1,2,3]
   [[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]
   λ> particiones "abcd"
   [["abcd"],["a","bcd"],["ab","cd"],["b","acd"],["abc","d"],["bc","ad"],
    ["ac","bd"],["c","abd"],["a","b","cd"],["a","bc","d"],["a","c","bd"],
    ["ab","c","d"],["b","ac","d"],["b","c","ad"],["a","b","c","d"]]

λ> particiones [1,2]

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

λ> particiones [1,2,3]

[[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]

λ> particiones "abcd"

[["abcd"],["a","bcd"],["ab","cd"],["b","acd"],["abc","d"],["bc","ad"],

["ac","bd"],["c","abd"],["a","b","cd"],["a","bc","d"],["a","c","bd"],

["ab","c","d"],["b","ac","d"],["b","c","ad"],["a","b","c","d"]]

Soluciones

import Data.Array
import Test.QuickCheck

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

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones (x:xs) =
  concat [([x] : yss) : inserta x yss | yss <- ysss]
  where ysss = particiones xs

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- elementos de yss. Por ejemplo, 
--    λ> inserta 1 [[2,3],[4],[5,6,7]]
--    [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

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

particiones2 :: [a] -> [[[a]]]
particiones2 [] = [[]]
particiones2 xs =
  concat [particionesFijas xs k | k <- [0..length xs]]

-- (particionesFijas xs k) es el conjunto de las particiones de xs en k
-- subconjuntos. Por ejemplo,
--    particionesFijas [1,2,3] 0  ==  []
--    particionesFijas [1,2,3] 1  ==  [[[1,2,3]]]
--    particionesFijas [1,2,3] 2  ==  [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]
--    particionesFijas [1,2,3] 3  ==  [[[1],[2],[3]]]
--    particionesFijas [1,2,3] 4  ==  []
particionesFijas :: [a] -> Int -> [[[a]]]
particionesFijas [] _ = []
particionesFijas xs 1 = [[xs]]
particionesFijas (x:xs) k =
   [[x]:ys | ys <- particionesFijas xs (k-1)] ++
   concat [inserta x ys | ys <- particionesFijas xs k]

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

particiones3 :: [a] -> [[[a]]]
particiones3 xs = concat [a ! (n,k) | k <- [0..n]]
  where a = matrizParticiones xs
        n = length xs

-- (matrizParticiones xs) es la matriz de dimensión ((0,0),(n,n)) que en
-- la posición (i,j) tiene el conjunto de particiones de los i primeros
-- elementoa de xs en j subconjuntos. Por ejemplo,
--   λ> elems (matrizParticiones [1,2,3])
--   [[[]],[],         [],                                   [],
--    [],  [[[1]]],    [],                                   [],
--    [],  [[[1,2]]],  [[[2],[1]]],                          [],
--    [],  [[[1,2,3]]],[[[3],[1,2]],[[3,2],[1]],[[2],[3,1]]],[[[3],[2],[1]]]]
matrizParticiones :: [a] -> Array (Int,Int) [[[a]]]
matrizParticiones xs = a 
  where
    n = length xs
    v = listArray (1,n) xs
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = [[]]
    f 0 _ = []
    f _ 0 = []
    f i 1 = [[[v!k | k <- [1..i]]]]
    f i j = [[v!i] : ys | ys <- a!(i-1,j-1)] ++
            concat [inserta (v!i) ys | ys <- a!(i-1,j)]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_Particiones :: [Int] -> Bool
prop_Particiones xs =
  all (== (ordenada . particiones) xs)
      [(ordenada . f )xs | f <- [ particiones2
                                , particiones3]]
        
ordenada :: Ord a => [[[a]]] -> [[[a]]]
ordenada xsss =
  sort [sort (map sort xss) | xss <- xsss]

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

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

--    λ> length (particiones [1..12])
--    4213597
--    (2.74 secs, 2,903,492,120 bytes)
--    λ> length (particiones2 [1..12])
--    4213597
--    (4.63 secs, 3,878,003,920 bytes)
--    λ> length (particiones3 [1..12])
--    4213597
--    (6.21 secs, 3,199,076,464 bytes)

100

101

import Data.Array

import Test.QuickCheck

-- 1ª solución

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

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones (x:xs) =

concat [([x] : yss) : inserta x yss | yss <- ysss]

where ysss = particiones xs

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- elementos de yss. Por ejemplo,

-- λ> inserta 1 [[2,3],[4],[5,6,7]]

-- [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- 2ª solución

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

particiones2 :: [a] -> [[[a]]]

particiones2 [] = [[]]

particiones2 xs =

concat [particionesFijas xs k | k <- [0..length xs]]

-- (particionesFijas xs k) es el conjunto de las particiones de xs en k

-- subconjuntos. Por ejemplo,

-- particionesFijas [1,2,3] 0 == []

-- particionesFijas [1,2,3] 1 == [[[1,2,3]]]

-- particionesFijas [1,2,3] 2 == [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]

-- particionesFijas [1,2,3] 3 == [[[1],[2],[3]]]

-- particionesFijas [1,2,3] 4 == []

particionesFijas :: [a] -> Int -> [[[a]]]

particionesFijas [] _ = []

particionesFijas xs 1 = [[xs]]

particionesFijas (x:xs) k =

[[x]:ys | ys <- particionesFijas xs (k-1)] ++

concat [inserta x ys | ys <- particionesFijas xs k]

-- 3ª solución

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

particiones3 :: [a] -> [[[a]]]

particiones3 xs = concat [a ! (n,k) | k <- [0..n]]

where a = matrizParticiones xs

n = length xs

-- (matrizParticiones xs) es la matriz de dimensión ((0,0),(n,n)) que en

-- la posición (i,j) tiene el conjunto de particiones de los i primeros

-- elementoa de xs en j subconjuntos. Por ejemplo,

-- λ> elems (matrizParticiones [1,2,3])

-- [[[]],[], [], [],

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

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

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

matrizParticiones :: [a] -> Array (Int,Int) [[[a]]]

matrizParticiones xs = a

where

n = length xs

v = listArray (1,n) xs

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

f 0 0 = [[]]

f 0 _ = []

f _ 0 = []

f i 1 = [[[v!k | k <- [1..i]]]]

f i j = [[v!i] : ys | ys <- a!(i-1,j-1)] ++

concat [inserta (v!i) ys | ys <- a!(i-1,j)]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_Particiones :: [Int] -> Bool

prop_Particiones xs =

all (== (ordenada . particiones) xs)

[(ordenada . f )xs | f <- [ particiones2

, particiones3]]

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

ordenada xsss =

sort [sort (map sort xss) | xss <- xsss]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_Particiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (particiones [1..12])

-- 4213597

-- (2.74 secs, 2,903,492,120 bytes)

-- λ> length (particiones2 [1..12])

-- 4213597

-- (4.63 secs, 3,878,003,920 bytes)

-- λ> length (particiones3 [1..12])

-- 4213597

-- (6.21 secs, 3,199,076,464 bytes)

Pensamiento

A quien nos justifica nuestra desconfianza
llamamos enemigo, ladrón de una esperanza.
Jamás perdona el necio si ve la nuez vacía
que dio a cascar al diente de la sabiduría.

Antonio Machado

Inserciones en una lista de listas

PorJosé A. Alonso 25-febrero-20194-marzo-2019

Definir la función

   inserta :: a -> [[a]] -> [[[a]]]

1	inserta :: a -> [[a]] -> [[[a]]]

tal que (inserta x yss) es la lista obtenida insertando x en cada uno de los elementos de yss. Por ejemplo,

   λ> inserta 1 [[2,3],[4],[5,6,7]]
   [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
   λ> inserta 'a' ["hoy","es","lunes"]
   [["ahoy","es","lunes"],["hoy","aes","lunes"],["hoy","es","alunes"]]

λ> inserta 1 [[2,3],[4],[5,6,7]]

[[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]

λ> inserta 'a' ["hoy","es","lunes"]

[["ahoy","es","lunes"],["hoy","aes","lunes"],["hoy","es","alunes"]]

Soluciones

-- 1ª solución
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

-- 2ª solución
inserta2 :: a -> [[a]] -> [[[a]]]
inserta2 _ []       = []
inserta2 x (ys:yss) = ((x:ys):yss) : map (ys:) (inserta2 x yss)

-- 1ª solución

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- 2ª solución

inserta2 :: a -> [[a]] -> [[[a]]]

inserta2 _ [] = []

inserta2 x (ys:yss) = ((x:ys):yss) : map (ys:) (inserta2 x yss)

Pensamiento

… De la mar al percepto,
del percepto al concepto,
del concepto a la idea
— ¡oh, la linda tarea! —
de la idea a la mar.
¡Y otra vez al empezar!

Antonio Machado

Divisiones del círculo

PorJosé A. Alonso 22-febrero-20191-marzo-2019

Dado 4 puntos de un círculo se pueden dibujar 2 cuerdas entre ellos de forma que no se corten. En efecto, si se enumeran los puntos del 1 al 4 en sentido de las agujas del reloj una forma tiene las cuerdas {1-2, 3-4} y la otra {1-4, 2-3}.

Definir la función

   numeroFormas :: Integer -> Integer

1	numeroFormas :: Integer -> Integer

tal que (numeroFormas n) es el número de formas que se pueden dibujar n cuerdas entre 2xn puntos de un círculo sin que se corten. Por ejemplo,

   numeroFormas 1   ==  1
   numeroFormas 2   ==  2
   numeroFormas 4   ==  14
   numeroFormas 75  ==  1221395654430378811828760722007962130791020
   length (show (numeroFormas 1000))  ==  598

numeroFormas 1 == 1

numeroFormas 2 == 2

numeroFormas 4 == 14

numeroFormas 75 == 1221395654430378811828760722007962130791020

length (show (numeroFormas 1000)) == 598

Soluciones

import Data.Array

-- 1ª definición
numeroFormas :: Integer -> Integer
numeroFormas 0 = 0
numeroFormas n = aux (2*n)
  where aux 0 = 1
        aux 2 = 1
        aux i = sum [aux j * aux (i-2-j) | j <- [0,2..i-1]]

-- 2ª definición
numeroFormas2 :: Integer -> Integer
numeroFormas2 0 = 0
numeroFormas2 n = v ! (2*n)
  where v   = array (0,2*n) [(i, f i) | i <- [0..2*n]]
        f 0 = 1
        f 2 = 1
        f i = sum [v ! j * v ! (i-2-j) | j <- [0,2..i-1]]

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

--    λ> numeroFormas 15
--    9694845
--    (28.49 secs, 4,293,435,552 bytes)
--    λ> numeroFormas2 15
--    9694845
--    (0.01 secs, 184,552 bytes)

import Data.Array

-- 1ª definición

numeroFormas :: Integer -> Integer

numeroFormas 0 = 0

numeroFormas n = aux (2*n)

where aux 0 = 1

aux 2 = 1

aux i = sum [aux j * aux (i-2-j) | j <- [0,2..i-1]]

-- 2ª definición

numeroFormas2 :: Integer -> Integer

numeroFormas2 0 = 0

numeroFormas2 n = v ! (2*n)

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

f 0 = 1

f 2 = 1

f i = sum [v ! j * v ! (i-2-j) | j <- [0,2..i-1]]

-- Comparación de eficiencia

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

-- λ> numeroFormas 15

-- 9694845

-- (28.49 secs, 4,293,435,552 bytes)

-- λ> numeroFormas2 15

-- 9694845

-- (0.01 secs, 184,552 bytes)

Pensamiento

… Y si la vida es corta
y no llega la mar a tu galera,
aguarda sin partir y siempre espera,
que el arte es largo y, además no importa.

Antonio Machado

Mayor exponente

PorJosé A. Alonso 20-febrero-201927-febrero-2019

Definir las funciones

   mayorExponente        :: Integer -> Integer
   graficaMayorExponente :: Integer -> IO ()

1 2	mayorExponente :: Integer -> Integer graficaMayorExponente :: Integer -> IO ()

tales que

(mayorExponente n) es el mayor número b para el que existe un a tal que n = a^b. Se supone que n > 1. Por ejemplo,

     mayorExponente 9   ==  2
     mayorExponente 8   ==  3
     mayorExponente 7   ==  1
     mayorExponente 18  ==  1
     mayorExponente 36  ==  2
     mayorExponente (10^(10^5))  ==  100000

mayorExponente 9 == 2

mayorExponente 8 == 3

mayorExponente 7 == 1

mayorExponente 18 == 1

mayorExponente 36 == 2

mayorExponente (10^(10^5)) == 100000

(graficaMayorExponente n) dibuja la gráfica de los mayores exponentes de los números entre 2 y n. Por ejemplo, (graficaMayorExponente 50) dibuja

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
import Graphics.Gnuplot.Simple


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

mayorExponente :: Integer -> Integer
mayorExponente x =
  last [b | b <- [1..x]
          , a <- [1..x]
          , a^b == x]

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

mayorExponente2 :: Integer -> Integer
mayorExponente2 x =
  head [b | b <- [x,x-1..1]
          , a <- [1..x]
          , a^b == x]

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

mayorExponente3 :: Integer -> Integer
mayorExponente3 x = aux x
  where aux 1 = 1
        aux b | any (\a -> a^b == x) [1..x] = b
              | otherwise                   = aux (b-1)

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

mayorExponente4 :: Integer -> Integer
mayorExponente4 x =
  mcd (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorizacioń de
-- x. por ejemplo.
--    exponentes 720  ==  [4,2,1]
exponentes :: Integer -> [Integer]
exponentes x =
  map genericLength (group (primeFactors x))

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
mcd :: [Integer] -> Integer
mcd = foldr1 gcd

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_mayorExponente :: Integer -> Property
prop_mayorExponente n =
  n >= 0 ==>
  mayorExponente  n == mayorExponente2 n &&
  mayorExponente2 n == mayorExponente3 n

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

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

--    λ> mayorExponente (10^3)
--    3
--    (3.96 secs, 4,671,928,464 bytes)
--    λ> mayorExponente2 (10^3)
--    3
--    (3.99 secs, 4,670,107,024 bytes)
--    λ> mayorExponente3 (10^3)
--    3
--    (3.90 secs, 4,686,383,952 bytes)
--    λ> mayorExponente4 (10^3)
--    3
--    (0.02 secs, 131,272 bytes)

-- Definición de graficaMayorExponente
-- ======================================

graficaMayorExponente :: Integer -> IO ()
graficaMayorExponente n = 
  plotList [ Key Nothing
           , PNG ("MayorExponente.png")
           ]
           (map mayorExponente3 [2..n])

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª solución

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

mayorExponente :: Integer -> Integer

mayorExponente x =

last [b | b <- [1..x]

, a <- [1..x]

, a^b == x]

-- 2ª solución

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

mayorExponente2 :: Integer -> Integer

mayorExponente2 x =

head [b | b <- [x,x-1..1]

, a <- [1..x]

, a^b == x]

-- 3ª solución

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

mayorExponente3 :: Integer -> Integer

mayorExponente3 x = aux x

where aux 1 = 1

aux b | any (\a -> a^b == x) [1..x] = b

| otherwise = aux (b-1)

-- 4ª solución

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

mayorExponente4 :: Integer -> Integer

mayorExponente4 x =

mcd (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorizacioń de

-- x. por ejemplo.

-- exponentes 720 == [4,2,1]

exponentes :: Integer -> [Integer]

exponentes x =

map genericLength (group (primeFactors x))

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,

-- mcd [4,6,10] == 2

mcd :: [Integer] -> Integer

mcd = foldr1 gcd

-- Comprobación de equivalencia

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

-- La propiedad es

prop_mayorExponente :: Integer -> Property

prop_mayorExponente n =

n >= 0 ==>

mayorExponente n == mayorExponente2 n &&

mayorExponente2 n == mayorExponente3 n

-- La comprobación es

-- λ> quickCheck prop_mayorExponente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> mayorExponente (10^3)

-- 3

-- (3.96 secs, 4,671,928,464 bytes)

-- λ> mayorExponente2 (10^3)

-- 3

-- (3.99 secs, 4,670,107,024 bytes)

-- λ> mayorExponente3 (10^3)

-- 3

-- (3.90 secs, 4,686,383,952 bytes)

-- λ> mayorExponente4 (10^3)

-- 3

-- (0.02 secs, 131,272 bytes)

-- Definición de graficaMayorExponente

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

graficaMayorExponente :: Integer -> IO ()

graficaMayorExponente n =

plotList [ Key Nothing

, PNG ("MayorExponente.png")

]

(map mayorExponente3 [2..n])

Pensamiento

Mirando mi calavera
un nuevo Hamlet dirá:
He aquí un lindo fósil de una
careta de carnaval.

Antonio Machado

Ternas euclídeas

PorJosé A. Alonso 18-febrero-201925-febrero-2019

Uno de los problemas planteados por Euclides en los Elementos consiste en encontrar tres números tales que cada uno de sus productos, dos a dos, aumentados en la unidad sea un cuadrado perfecto.

Diremos que (x,y,z) es una terna euclídea si es una solución del problema; es decir, si x <= y <= z y xy+1, yz+1 y zx+1 son cuadrados. Por ejemplo, (4,6,20) es una terna euclídea ya que

   4x6+1 = 5^2, 6x20+1 = 11^2 y 20*4+1 = 9^2

1	4x6+1 = 5^2, 6x20+1 = 11^2 y 20*4+1 = 9^2

Definir la funciones

   ternasEuclideas        :: [(Integer,Integer,Integer)]
   esMayorDeTernaEuclidea :: Integer -> Bool

1 2	ternasEuclideas :: [(Integer,Integer,Integer)] esMayorDeTernaEuclidea :: Integer -> Bool

tales que

ternasEuclideas es la lista de las ternas euclídeas. Por ejemplo,

     λ> take 7 ternasEuclideas
     [(1,3,8),(2,4,12),(1,8,15),(3,5,16),(4,6,20),(3,8,21),(5,7,24)]

1 2	λ> take 7 ternasEuclideas [(1,3,8),(2,4,12),(1,8,15),(3,5,16),(4,6,20),(3,8,21),(5,7,24)]

(esMayorDeTernaEuclidea z) se verifica si existen x, y tales que (x,y,z) es una terna euclídea. Por ejemplo,

     esMayorDeTernaEuclidea 20  ==  True
     esMayorDeTernaEuclidea 22  ==  False

1 2	esMayorDeTernaEuclidea 20 == True esMayorDeTernaEuclidea 22 == False

Comprobar con QuickCheck que z es el mayor de una terna euclídea si, y sólo si, existe un número natural x tal que 1 < x < z – 1 y x^2 es congruente con 1 módulo z.

Soluciones

import Test.QuickCheck

ternasEuclideas :: [(Integer,Integer,Integer)]
ternasEuclideas =
  [(x,y,z) | z <- [1..]
           , y <- [1..z]
           , esCuadrado (y * z + 1)
           , x <- [1..y]
           , esCuadrado (x * y + 1)
           , esCuadrado (z * x + 1)]

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

esMayorDeTernaEuclidea :: Integer -> Bool
esMayorDeTernaEuclidea z =
  not (null [(x,y) | y <- [1..z]
                   , esCuadrado (y * z + 1)
                   , x <- [1..y]
                   , esCuadrado (x * y + 1)
                   , esCuadrado (z * x + 1)])


-- La propiedad es
prop_esMayorDeTernaEuclidea :: Positive Integer -> Bool
prop_esMayorDeTernaEuclidea (Positive z) =
  esMayorDeTernaEuclidea z == any (\x -> (x^2) `mod` z == 1) [2..z-2]

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

import Test.QuickCheck

ternasEuclideas :: [(Integer,Integer,Integer)]

ternasEuclideas =

[(x,y,z) | z <- [1..]

, y <- [1..z]

, esCuadrado (y * z + 1)

, x <- [1..y]

, esCuadrado (x * y + 1)

, esCuadrado (z * x + 1)]

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

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

where raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

esMayorDeTernaEuclidea :: Integer -> Bool

esMayorDeTernaEuclidea z =

not (null [(x,y) | y <- [1..z]

, esCuadrado (y * z + 1)

, x <- [1..y]

, esCuadrado (x * y + 1)

, esCuadrado (z * x + 1)])

-- La propiedad es

prop_esMayorDeTernaEuclidea :: Positive Integer -> Bool

prop_esMayorDeTernaEuclidea (Positive z) =

esMayorDeTernaEuclidea z == any (\x -> (x^2) `mod` z == 1) [2..z-2]

-- La comprobación es

-- λ> quickCheck prop_esMayorDeTernaEuclidea

-- +++ OK, passed 100 tests.

Pensamiento

Todo pasa y todo queda,
pero lo nuestro es pasar,
pasar haciendo caminos,
caminos sobre la mar.

Antonio Machado

Límites de sucesiones

PorJosé A. Alonso 4-febrero-201911-febrero-2019

El límite de una sucesión, con una aproximación a y una amplitud n, es el primer término x de la sucesión tal que el valor absoluto de x y cualquiera de sus n siguentes elementos es menor que a.

Definir la función

   limite :: [Double] -> Double -> Int -> Double

1	limite :: [Double] -> Double -> Int -> Double

tal que (limite xs a n) es el límite de xs xon aproximación a y amplitud n. Por ejemplo,

   λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300
   1.993991989319092
   λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300
   1.9998260062637745
   λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300
   2.7155953364173175

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300

1.993991989319092

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300

1.9998260062637745

λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300

2.7155953364173175

Soluciones

import Data.List (tails)

limite :: [Double] -> Double -> Int -> Double
limite xs a n = 
  head [ x | (x:ys) <- segmentos xs n
       , all (\y ->  abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs
-- con n elementos. Por ejemplo,   
--    λ> take 5 (segmentos [1..] 3)
--    [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]]
segmentos :: [a] -> Int -> [[a]]
segmentos xs n = map (take n) (tails xs)

import Data.List (tails)

limite :: [Double] -> Double -> Int -> Double

limite xs a n =

head [ x | (x:ys) <- segmentos xs n

, all (\y -> abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs

-- con n elementos. Por ejemplo,

-- λ> take 5 (segmentos [1..] 3)

-- [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]]

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

segmentos xs n = map (take n) (tails xs)

Pensamiento

De diez cabezas, nueve
embisten y una piensa.
Nunca extrañéis que un bruto
se descuerne luchando por la idea.

Antonio Machado

Dígitos en las posiciones pares de cuadrados

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

Definir las funciones

   digitosPosParesCuadrado    :: Integer -> ([Integer],Int)
   invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

1 2	digitosPosParesCuadrado :: Integer -> ([Integer],Int) invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

tales que

(digitosPosParesCuadrado n) es el par formados por los dígitos de n² en la posiciones pares y por el número de dígitos de n². Por ejemplo,

     digitosPosParesCuadrado 8     ==  ([6],2)
     digitosPosParesCuadrado 14    ==  ([1,6],3)
     digitosPosParesCuadrado 36    ==  ([1,9],4)
     digitosPosParesCuadrado 116   ==  ([1,4,6],5)
     digitosPosParesCuadrado 2019  ==  ([4,7,3,1],7)

digitosPosParesCuadrado 8 == ([6],2)

digitosPosParesCuadrado 14 == ([1,6],3)

digitosPosParesCuadrado 36 == ([1,9],4)

digitosPosParesCuadrado 116 == ([1,4,6],5)

digitosPosParesCuadrado 2019 == ([4,7,3,1],7)

(invDigitosPosParesCuadrado (xs,k)) es la lista de los números n tales que xs es la lista de los dígitos de n² en la posiciones pares y k es el número de dígitos de n². Por ejemplo,

     invDigitosPosParesCuadrado ([6],2)             ==  [8]
     invDigitosPosParesCuadrado ([1,6],3)           ==  [14]
     invDigitosPosParesCuadrado ([1,9],4)           ==  [36]
     invDigitosPosParesCuadrado ([1,4,6],5)         ==  [116,136]
     invDigitosPosParesCuadrado ([4,7,3,1],7)       ==  [2019,2139,2231]
     invDigitosPosParesCuadrado ([1,2],3)           ==  []
     invDigitosPosParesCuadrado ([1,2],4)           ==  [32,35,39]
     invDigitosPosParesCuadrado ([1,2,3,4,5,6],11)  ==  [115256,127334,135254]

invDigitosPosParesCuadrado ([6],2) == [8]

invDigitosPosParesCuadrado ([1,6],3) == [14]

invDigitosPosParesCuadrado ([1,9],4) == [36]

invDigitosPosParesCuadrado ([1,4,6],5) == [116,136]

invDigitosPosParesCuadrado ([4,7,3,1],7) == [2019,2139,2231]

invDigitosPosParesCuadrado ([1,2],3) == []

invDigitosPosParesCuadrado ([1,2],4) == [32,35,39]

invDigitosPosParesCuadrado ([1,2,3,4,5,6],11) == [115256,127334,135254]

Comprobar con QuickCheck que para todo entero positivo n se verifica que para todo entero positivo m, m pertenece a (invDigitosPosParesCuadrado (digitosPosParesCuadrado n)) si, y sólo si, (digitosPosParesCuadrado m) es igual a (digitosPosParesCuadrado n)

Soluciones

import Test.QuickCheck

-- Definición de digitosPosParesCuadrado
-- =====================================

digitosPosParesCuadrado :: Integer -> ([Integer],Int)
digitosPosParesCuadrado n =
  (digitosPosPares (n^2),length (show (n^2)))

-- (digitosPosPares n) es la lista de los dígitos de n en posiciones
-- pares. Por ejemplo,
--    digitosPosPares 24012019  ==  [2,0,2,1]
digitosPosPares :: Integer -> [Integer]
digitosPosPares n = elementosPosPares (digitos n)

-- (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]

-- (elementosPosPares xs) es la lista de los elementos de xs en
-- posiciones pares. Por ejemplo,
--    elementosPosPares [3,2,5,7,6,4]  ==  [3,5,6]
elementosPosPares :: [a] -> [a]
elementosPosPares []       = []
elementosPosPares [x]      = [x]
elementosPosPares (x:_:zs) = x : elementosPosPares zs

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

invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]
invDigitosPosParesCuadrado (xs, a) =
  [x | x <- [ceiling (sqrt 10^(a-1))..ceiling (sqrt 10^a)]
     , digitosPosParesCuadrado x == (xs,a)]

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

invDigitosPosParesCuadrado2 :: ([Integer],Int) -> [Integer]
invDigitosPosParesCuadrado2 x =
  [n | n <- [a..b], digitosPosParesCuadrado n == x]
  where a = floor (sqrt (fromIntegral (completaNum x 0)))
        b = ceiling (sqrt (fromIntegral (completaNum x 9)))

-- (completaNum (xs,k) n) es el número cuyos dígitos en las posiciones
-- pares son los de xs y los de las posiciones impares son iguales a n
-- (se supone que k es igual al doble de la longitud de xs o un
-- menos). Por ejemplo, 
--    completaNum ([1,3,8],5) 4  ==  14348
--    completaNum ([1,3,8],6) 4  ==  143484
completaNum :: ([Integer],Int) -> Integer -> Integer
completaNum x n = digitosAnumero (completa x n)

-- (completa (xs,k) n) es la lista cuyos elementos en las posiciones
-- pares son los de xs y los de las posiciones impares son iguales a n
-- (se supone que k es igual al doble de la longitud de xs o un
-- menos). Por ejemplo, 
--    completa ([1,3,8],5) 4  ==  [1,4,3,4,8]
--    completa ([1,3,8],6) 4  ==  [1,4,3,4,8,4]
completa :: ([Integer],Int) -> Integer -> [Integer]
completa (xs,k) n
  | even k    = ys
  | otherwise = init ys
  where ys = concat [[x,n] | x <- xs]

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

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

--    λ> invDigitosPosParesCuadrado ([1,2,1,5,7,4,9],13)
--    [1106393,1234567,1314597]
--    (7.55 secs, 13,764,850,536 bytes)
--    λ> invDigitosPosParesCuadrado2 ([1,2,1,5,7,4,9],13)
--    [1106393,1234567,1314597]
--    (1.96 secs, 3,780,368,816 bytes)

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

-- La propiedad es  
prop_digitosPosParesCuadrado :: Positive Integer -> Positive Integer -> Bool
prop_digitosPosParesCuadrado (Positive n) (Positive m) =
  (digitosPosParesCuadrado m == x)
  == (m `elem` invDigitosPosParesCuadrado x)
  where x = digitosPosParesCuadrado n

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

import Test.QuickCheck

-- Definición de digitosPosParesCuadrado

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

digitosPosParesCuadrado :: Integer -> ([Integer],Int)

digitosPosParesCuadrado n =

(digitosPosPares (n^2),length (show (n^2)))

-- (digitosPosPares n) es la lista de los dígitos de n en posiciones

-- pares. Por ejemplo,

-- digitosPosPares 24012019 == [2,0,2,1]

digitosPosPares :: Integer -> [Integer]

digitosPosPares n = elementosPosPares (digitos n)

-- (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]

-- (elementosPosPares xs) es la lista de los elementos de xs en

-- posiciones pares. Por ejemplo,

-- elementosPosPares [3,2,5,7,6,4] == [3,5,6]

elementosPosPares :: [a] -> [a]

elementosPosPares [] = []

elementosPosPares [x] = [x]

elementosPosPares (x:_:zs) = x : elementosPosPares zs

-- 1ª definición de invDigitosPosParesCuadrado

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

invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

invDigitosPosParesCuadrado (xs, a) =

[x | x <- [ceiling (sqrt 10^(a-1))..ceiling (sqrt 10^a)]

, digitosPosParesCuadrado x == (xs,a)]

-- 2ª definición de invDigitosPosParesCuadrado

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

invDigitosPosParesCuadrado2 :: ([Integer],Int) -> [Integer]

invDigitosPosParesCuadrado2 x =

[n | n <- [a..b], digitosPosParesCuadrado n == x]

where a = floor (sqrt (fromIntegral (completaNum x 0)))

b = ceiling (sqrt (fromIntegral (completaNum x 9)))

-- (completaNum (xs,k) n) es el número cuyos dígitos en las posiciones

-- pares son los de xs y los de las posiciones impares son iguales a n

-- (se supone que k es igual al doble de la longitud de xs o un

-- menos). Por ejemplo,

-- completaNum ([1,3,8],5) 4 == 14348

-- completaNum ([1,3,8],6) 4 == 143484

completaNum :: ([Integer],Int) -> Integer -> Integer

completaNum x n = digitosAnumero (completa x n)

-- (completa (xs,k) n) es la lista cuyos elementos en las posiciones

-- pares son los de xs y los de las posiciones impares son iguales a n

-- (se supone que k es igual al doble de la longitud de xs o un

-- menos). Por ejemplo,

-- completa ([1,3,8],5) 4 == [1,4,3,4,8]

-- completa ([1,3,8],6) 4 == [1,4,3,4,8,4]

completa :: ([Integer],Int) -> Integer -> [Integer]

completa (xs,k) n

| even k = ys

| otherwise = init ys

where ys = concat [[x,n] | x <- xs]

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

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero = read . concatMap show

-- Comparación de eficiencia

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

-- λ> invDigitosPosParesCuadrado ([1,2,1,5,7,4,9],13)

-- [1106393,1234567,1314597]

-- (7.55 secs, 13,764,850,536 bytes)

-- λ> invDigitosPosParesCuadrado2 ([1,2,1,5,7,4,9],13)

-- [1106393,1234567,1314597]

-- (1.96 secs, 3,780,368,816 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_digitosPosParesCuadrado :: Positive Integer -> Positive Integer -> Bool

prop_digitosPosParesCuadrado (Positive n) (Positive m) =

(digitosPosParesCuadrado m == x)

== (m `elem` invDigitosPosParesCuadrado x)

where x = digitosPosParesCuadrado n

-- La comprobación es

-- λ> quickCheck prop_digitosPosParesCuadrado

-- +++ OK, passed 100 tests.

Pensamiento

¡Ojos que a la luz se abrieron
un día para, después,
ciegos tornar a la tierra,
hartos de mirar sin ver.

Antonio Machado

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

Á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

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

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

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

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

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico