Medio – Página 11

Índices de números de Fibonacci

PorJosé A. Alonso 2-marzo-201626-marzo-2022

Los primeros términos de la sucesión de Fibonacci son

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34

1	0, 1, 1, 2, 3, 5, 8, 13, 21, 34

Se observa que el 6º término de la sucesión (comenzando a contar en 0) es el número 8.

Definir la función

   indiceFib :: Integer -> Maybe Integer

1	indiceFib :: Integer -> Maybe Integer

tal que (indiceFib x) es justo el número n si x es el n-ésimo términos de la sucesión de Fibonacci o Nothing en el caso de que x no pertenezca a la sucesión. Por ejemplo,

    indiceFib 8                                           == Just 6
    indiceFib 9                                           == Nothing
    indiceFib 21                                          == Just 8
    indiceFib 22                                          == Nothing
    indiceFib 280571172992510140037611932413038677189525  == Just 200
    indiceFib 123456789012345678901234567890123456789012  == Nothing

indiceFib 8 == Just 6

indiceFib 9 == Nothing

indiceFib 21 == Just 8

indiceFib 22 == Nothing

indiceFib 280571172992510140037611932413038677189525 == Just 200

indiceFib 123456789012345678901234567890123456789012 == Nothing

Soluciones

indiceFib :: Integer -> Maybe Integer
indiceFib x | y == x    = Just n
            | otherwise = Nothing
    where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de la sucesión de Fibonacci. Por
-- ejemplo, 
--    take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]
fibs :: [Integer]
fibs = 0 : 1 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci
-- juntos con sus posiciones. Por ejemplo,
--    ghci> take 10 fibsNumerados
--    [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]
fibsNumerados :: [(Integer,Integer)]
fibsNumerados = zip fibs [0..]

indiceFib :: Integer -> Maybe Integer

indiceFib x | y == x = Just n

| otherwise = Nothing

where (y,n) = head (dropWhile (\(z,m) -> z < x) fibsNumerados)

-- fibs es la lista de los términos de la sucesión de Fibonacci. Por

-- ejemplo,

-- take 10 fibs == [0,1,1,2,3,5,8,13,21,34]

fibs :: [Integer]

fibs = 0 : 1 : [x+y | (x,y) <- zip fibs (tail fibs)]

-- fibsNumerados es la lista de los términos de la sucesión de Fibonacci

-- juntos con sus posiciones. Por ejemplo,

-- ghci> take 10 fibsNumerados

-- [(0,0),(1,1),(1,2),(2,3),(3,4),(5,5),(8,6),(13,7),(21,8),(34,9)]

fibsNumerados :: [(Integer,Integer)]

fibsNumerados = zip fibs [0..]

En Maxima

indiceFib (n) := block([a:0,b:1,c:1,p:0],
  unless n <= a do
   (a : b,
    b : c,
    c : a + b,
    p : p + 1),
  if n = a
  then Just (p)
  else Nothing)$

indiceFib (n) := block([a:0,b:1,c:1,p:0],

unless n <= a do

(a : b,

b : c,

c : a + b,

p : p + 1),

if n = a

then Just (p)

else Nothing)$

Integración por el método de los rectángulos

PorJosé A. Alonso 1-marzo-20161-mayo-2016

La integral definida de una función f entre los límites a y b puede calcularse mediante la regla del rectángulo usando la fórmula

   h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

1	h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

con a+nh+h/2 ≤ b < a+(n+1)h+h/2 y usando valores pequeños para h.

Definir la función

   integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

1	integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

tal que (integral a b f h) es el valor de dicha expresión. Por ejemplo, el cálculo de la integral de f(x) = x^3 entre 0 y 1, con paso 0.01, es

   integral 0 1 (^3) 0.01  ==  0.24998750000000042

1	integral 0 1 (^3) 0.01 == 0.24998750000000042

Otros ejemplos son

   integral 0 1 (^4) 0.01                        ==  0.19998333362500048
   integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01       ==  1.9999250000000026
   log 2 - integral 1 2 (\x -> 1/x) 0.01         ==  3.124931644782336e-6
   pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01  ==  -8.333333331389525e-6

integral 0 1 (^4) 0.01 == 0.19998333362500048

integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01 == 1.9999250000000026

log 2 - integral 1 2 (\x -> 1/x) 0.01 == 3.124931644782336e-6

pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01 == -8.333333331389525e-6

Nota: Definir la función también en Maxima. Por ejemplo,

   (%i3) integral (0,1,lambda ([x],x^3),0.01);
   (%o3) 0.2499875

1 2	(%i3) integral (0,1,lambda ([x],x^3),0.01); (%o3) 0.2499875

Soluciones

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de
--    f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    suma 2 5 (1+) (^3)  ==  224
suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a
suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista
--    [a, s(a), s(s(a), ..., s(...(s(a))...)]
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    sucesion 3 20 (+2)  ==  [3,5,7,9,11,13,15,17,19]
sucesion :: Ord a => a -> a -> (a -> a) -> [a]
sucesion a b s = takeWhile (<=b) (iterate s a)

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral2 a b f h
    | a+h/2 > b = 0
    | otherwise = h * f (a+h/2) + integral2 (a+h) b f h

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral3 a b f h = aux a where
    aux x | x+h/2 > b = 0
          | otherwise = h * f (x+h/2) + aux (x+h)

-- 1ª solución

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de

-- f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- suma 2 5 (1+) (^3) == 224

suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a

suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista

-- [a, s(a), s(s(a), ..., s(...(s(a))...)]

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- sucesion 3 20 (+2) == [3,5,7,9,11,13,15,17,19]

sucesion :: Ord a => a -> a -> (a -> a) -> [a]

sucesion a b s = takeWhile (<=b) (iterate s a)

-- 2ª solución

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral2 a b f h

| a+h/2 > b = 0

| otherwise = h * f (a+h/2) + integral2 (a+h) b f h

-- 3ª solución

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral3 a b f h = aux a where

aux x | x+h/2 > b = 0

| otherwise = h * f (x+h/2) + aux (x+h)

Solución en Maxima

integral (a,b,f,h) := block ([c:a+h/2, s:0],
  while c <= b do
    ( s : s + f(c),
      c : c+h),
  float(h*s))$

integral (a,b,f,h) := block ([c:a+h/2, s:0],

while c <= b do

( s : s + f(c),

c : c+h),

float(h*s))$

Nota: En Maxima esta definida la función integrate para calcular integrales definidas. Por ejemplo,

     (%i7) integrate (x^3,x,0,1);
           1
     (%o7) -
           4
     (%i8) %, numer;
     (%o8) 0.25

(%i7) integrate (x^3,x,0,1);

(%o7) -

(%i8) %, numer;

(%o8) 0.25

Regresión lineal

PorJosé A. Alonso 22-febrero-201626-marzo-2022

Dadas dos listas de valores

   xs = [x(1), x(2), ..., x(n)]
   ys = [y(1), y(2), ..., y(n)]

1 2	xs = [x(1), x(2), ..., x(n)] ys = [y(1), y(2), ..., y(n)]

la ecuación de la recta de regresión de ys sobre xs es y = a+bx, donde

   b = (nΣx(i)y(i) - Σx(i)Σy(i)) / (nΣx(i)² - (Σx(i))²)
   a = (Σy(i) - bΣx(i)) / n

1 2	b = (nΣx(i)y(i) - Σx(i)Σy(i)) / (nΣx(i)² - (Σx(i))²) a = (Σy(i) - bΣx(i)) / n

Definir la función

   regresionLineal :: [Double] -> [Double] -> (Double,Double)

1	regresionLineal :: [Double] -> [Double] -> (Double,Double)

tal que (regresionLineal xs ys) es el par (a,b) de los coeficientes de la recta de regresión de ys sobre xs. Por ejemplo, para los valores

   ejX, ejY :: [Double]
   ejX = [5,  7, 10, 12, 16, 20, 23, 27, 19, 14]
   ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

ejX, ejY :: [Double]

ejX = [5, 7, 10, 12, 16, 20, 23, 27, 19, 14]

ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

se tiene

   λ> regresionLineal ejX ejY
   (5.195045748716805,0.9218924347243919)

1 2	λ> regresionLineal ejX ejY (5.195045748716805,0.9218924347243919)

Definir el procedimiento

   grafica :: [Double] -> [Double] -> IO ()

1	grafica :: [Double] -> [Double] -> IO ()

tal que (grafica xs ys) pinte los puntos correspondientes a las listas de valores xs e ys y su recta de regresión. Por ejemplo, con (grafica ejX ejY) se obtiene el siguiente dibujo

Soluciones

import Graphics.Gnuplot.Simple

ejX, ejY :: [Double]
ejX = [5,  7, 10, 12, 16, 20, 23, 27, 19, 14]
ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

regresionLineal :: [Double] -> [Double] -> (Double,Double)
regresionLineal xs ys = (a,b)
    where n     = fromIntegral (length xs)
          sumX  = sum xs
          sumY  = sum ys
          sumX2 = sum (zipWith (*) xs xs)
          sumY2 = sum (zipWith (*) ys ys)
          sumXY = sum (zipWith (*) xs ys)
          b     = (n*sumXY - sumX*sumY) / (n*sumX2 - sumX^2)
          a     = (sumY - b*sumX) / n

grafica :: [Double] -> [Double] -> IO ()
grafica xs ys = 
    plotPathsStyle 
      [YRange (0,10+mY)] 
      [(defaultStyle {plotType = Points,
                      lineSpec = CustomStyle [LineTitle "Datos",
                                              PointType 2,
                                              PointSize 2.5]},
                     zip xs ys),
       (defaultStyle {plotType = Lines,
                      lineSpec = CustomStyle [LineTitle "Ajuste",
                                              LineWidth 2]},
                     [(x,a+b*x) | x <- [0..mX]])]
    where (a,b) = regresionLineal xs ys                      
          mX    = maximum xs 
          mY    = maximum ys

import Graphics.Gnuplot.Simple

ejX, ejY :: [Double]

ejX = [5, 7, 10, 12, 16, 20, 23, 27, 19, 14]

ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

regresionLineal :: [Double] -> [Double] -> (Double,Double)

regresionLineal xs ys = (a,b)

where n = fromIntegral (length xs)

sumX = sum xs

sumY = sum ys

sumX2 = sum (zipWith (*) xs xs)

sumY2 = sum (zipWith (*) ys ys)

sumXY = sum (zipWith (*) xs ys)

b = (n*sumXY - sumX*sumY) / (n*sumX2 - sumX^2)

a = (sumY - b*sumX) / n

grafica :: [Double] -> [Double] -> IO ()

grafica xs ys =

plotPathsStyle

[YRange (0,10+mY)]

[(defaultStyle {plotType = Points,

lineSpec = CustomStyle [LineTitle "Datos",

PointType 2,

PointSize 2.5]},

zip xs ys),

(defaultStyle {plotType = Lines,

lineSpec = CustomStyle [LineTitle "Ajuste",

LineWidth 2]},

[(x,a+b*x) | x <- [0..mX]])]

where (a,b) = regresionLineal xs ys

mX = maximum xs

mY = maximum ys

Cantidad de números Pentanacci impares

PorJosé A. Alonso 18-febrero-20162-mayo-2016

Los números de Pentanacci se definen mediante las ecuaciones

   P(0) = 0
   P(1) = 1
   P(2) = 1
   P(3) = 2
   P(4) = 4
   P(n) = P(n-1) + P(n-2) + P(n-3) + P(n-4) + P(n-5), si n > 4

P(0) = 0

P(1) = 1

P(2) = 1

P(3) = 2

P(4) = 4

P(n) = P(n-1) + P(n-2) + P(n-3) + P(n-4) + P(n-5), si n > 4

Los primeros números de Pentanacci son

  0, 1, 1, 2, 4, 8, 16, 31, 61, 120, 236, 464, 912, 1793, 3525, ...

1	0, 1, 1, 2, 4, 8, 16, 31, 61, 120, 236, 464, 912, 1793, 3525, ...

Se obseeva que

hasta P(5) hay 1 impar: el 1 (aunque aparece dos veces);
hasta P(7) hay 2 impares distintos: 1 y 31;
hasta P(10) hay 3 impares distintos: 1, 31 y 61;
hasta P(15) hay 5 impares distintos: 1, 31 y 61, 1793 y 3525.

Definir la función

   nPentanacciImpares :: Integer -> Integer

1	nPentanacciImpares :: Integer -> Integer

tal que (nPentanacciImpares n) es la cantidad de números impares distintos desde P(0) hasta P(n). Por ejemplo,

   nPentanacciImpares 5                             ==  1
   nPentanacciImpares 7                             ==  2
   nPentanacciImpares 10                            ==  3
   nPentanacciImpares 15                            ==  5
   nPentanacciImpares 100                           ==  33
   nPentanacciImpares 1000                          ==  333
   nPentanacciImpares 10000                         ==  3333
   nPentanacciImpares (10^(10^6)) `mod` (10^9)      ==  333333333
   length (show (nPentanacciImpares2 (10^(10^6))))  ==  1000000

nPentanacciImpares 5 == 1

nPentanacciImpares 7 == 2

nPentanacciImpares 10 == 3

nPentanacciImpares 15 == 5

nPentanacciImpares 100 == 33

nPentanacciImpares 1000 == 333

nPentanacciImpares 10000 == 3333

nPentanacciImpares (10^(10^6)) `mod` (10^9) == 333333333

length (show (nPentanacciImpares2 (10^(10^6)))) == 1000000

Soluciones

import Data.List (genericLength, genericTake)

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

nPentanacciImpares1 :: Integer -> Integer
nPentanacciImpares1 0 = 0
nPentanacciImpares1 1 = 1
nPentanacciImpares1 n = 
    genericLength (filter odd (genericTake (n+1) pentanacci)) - 1

pentanacci :: [Integer]
pentanacci = p (0, 1, 1, 2, 4)
    where p (a, b, c, d, e) = a : p (b, c, d, e, a + b + c + d + e)

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

-- λ> map nPentanacciImpares1 [1..31]
-- [1,1,1,1,1,1,2,3,3,3,3,3,4,5,5,5,5,5,6,7,7,7,7,7,8,9,9,9,9,9,10]
-- λ> [(head xs, length xs) | xs <- group (map nPentanacciImpares1 [1..37])]
-- [(1,6),(2,1),(3,5),(4,1),(5,5),(6,1),(7,5),(8,1),(9,5),(10,1),(11,5),(12,1)]

nPentanacciImpares2 :: Integer -> Integer
nPentanacciImpares2 0 = 0
nPentanacciImpares2 1 = 1
nPentanacciImpares2 n = 2 * q + min r 2 - 1
    where (q,r) = n `quotRem` 6

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

nPentanacciImpares3 :: Integer -> Integer
nPentanacciImpares3 0 = 0
nPentanacciImpares3 1 = 1
nPentanacciImpares3 n | r == 5    = 2*q + 2 
                      | otherwise = 2*q + 1 
    where (q,r) = divMod (n-2) 6

import Data.List (genericLength, genericTake)

-- 1ª definición

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

nPentanacciImpares1 :: Integer -> Integer

nPentanacciImpares1 0 = 0

nPentanacciImpares1 1 = 1

nPentanacciImpares1 n =

genericLength (filter odd (genericTake (n+1) pentanacci)) - 1

pentanacci :: [Integer]

pentanacci = p (0, 1, 1, 2, 4)

where p (a, b, c, d, e) = a : p (b, c, d, e, a + b + c + d + e)

-- 2ª definición

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

-- λ> map nPentanacciImpares1 [1..31]

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

-- λ> [(head xs, length xs) | xs <- group (map nPentanacciImpares1 [1..37])]

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

nPentanacciImpares2 :: Integer -> Integer

nPentanacciImpares2 0 = 0

nPentanacciImpares2 1 = 1

nPentanacciImpares2 n = 2 * q + min r 2 - 1

where (q,r) = n `quotRem` 6

-- 3ª definición

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

nPentanacciImpares3 :: Integer -> Integer

nPentanacciImpares3 0 = 0

nPentanacciImpares3 1 = 1

nPentanacciImpares3 n | r == 5 = 2*q + 2

| otherwise = 2*q + 1

where (q,r) = divMod (n-2) 6

Números como suma de N sumandos

PorJosé A. Alonso 15-febrero-201622-febrero-2016

Definir la función

   sumas :: Int -> [Int] -> [Int]

1	sumas :: Int -> [Int] -> [Int]

tal que (sumas n xs) es la lista de los números que se pueden obtener como suma de n, o menos, elementos de xs. Por ejemplo,

   sumas 0 [2,5]              ==  [0]
   sumas 1 [2,5]              ==  [0,2,5]
   sumas 2 [2,5]              ==  [0,2,4,5,7,10]
   sumas 3 [2,5]              ==  [0,2,4,5,6,7,9,10,12,15]
   sumas 2 [2,3,5]            ==  [0,2,3,4,5,6,7,8,10]
   sumas 3 [2,3,5]            ==  [0,2,3,4,5,6,7,8,9,10,11,12,13,15]
   length (sumas 8 [1..200])  ==  1601

sumas 0 [2,5] == [0]

sumas 1 [2,5] == [0,2,5]

sumas 2 [2,5] == [0,2,4,5,7,10]

sumas 3 [2,5] == [0,2,4,5,6,7,9,10,12,15]

sumas 2 [2,3,5] == [0,2,3,4,5,6,7,8,10]

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

length (sumas 8 [1..200]) == 1601

Soluciones

import Data.List (nub, sort)

sumas :: Int -> [Int] -> [Int]
sumas 0 _  = [0]
sumas n xs = nub (sort (ys ++ [x+y | x <- xs, y <- ys]))
    where ys = sumas (n-1) xs

import Data.List (nub, sort)

sumas :: Int -> [Int] -> [Int]

sumas 0 _ = [0]

sumas n xs = nub (sort (ys ++ [x+y | x <- xs, y <- ys]))

where ys = sumas (n-1) xs

Solución con Maxima

sumas (n,xs) := block ([ys],
  if n > 0
  then ( ys : sumas (n-1, xs),
         unique (append (ys, create_list (x+y,x,xs,y,ys))) )
  else [0])$

sumas (n,xs) := block ([ys],

if n > 0

then ( ys : sumas (n-1, xs),

unique (append (ys, create_list (x+y,x,xs,y,ys))) )

else [0])$

Anotación de la profundidad de los nodos

PorJosé A. Alonso 12-febrero-201619-febrero-2016

Los árboles binarios con datos en los nodos y hojas se definen por

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

          3
         / \
        /   \
       4     7
      / \   / \
     5   0 0   3
    / \
   2   0

/ \

4 7

/ \ / \

5 0 0 3

/ \

2 0

se representa por

   ejArbol :: Arbol Integer
   ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

1 2	ejArbol :: Arbol Integer ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

Anotando cada elemento del árbol anterior con su profundidad, se obtiene el árbol siguiente

          3-0
          / \
         /   \
        /     \
      4-1     7-1
      / \     / \
    5-2 0-2 0-2 3-0
    / \
  2-3 0-3

3-0

/ \

4-1 7-1

/ \ / \

5-2 0-2 0-2 3-0

/ \

2-3 0-3

Definir la función

   anotado :: Arbol a -> Arbol (a,Int)

1	anotado :: Arbol a -> Arbol (a,Int)

tal que (anotado x) es el árbol obtenido anotando los elementos de x con su profundidad. Por ejemplo,

   λ> anotado ejArbol
   N (3,0) 
     (N (4,1) 
        (N (5,2) (H (2,3)) (H (0,3))) 
        (H (0,2))) 
     (N (7,1) (H (0,2)) (H (3,2)))

λ> anotado ejArbol

N (3,0)

(N (4,1)

(N (5,2) (H (2,3)) (H (0,3)))

(H (0,2)))

(N (7,1) (H (0,2)) (H (3,2)))

Soluciones

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

ejArbol :: Arbol Integer
ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

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

anotado1 :: Arbol a -> Arbol (a,Int)
anotado1 (H x)     = H (x,0)
anotado1 (N x i d) = aux (N x i d) 0
    where aux (H x)     n = H (x,n)
          aux (N x i d) n = N (x,n) (aux i (n+1)) (aux d (n+1))  

-- 2ª solución
anotado2 :: Arbol a -> Arbol (a, Int)
anotado2 a = aux a [0..]
    where aux (H a)     (n:_ ) = H (a,n)
          aux (N a i d) (n:ns) = N (a,n) (aux i ns) (aux d ns)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Integer

ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

-- 1ª solución

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

anotado1 :: Arbol a -> Arbol (a,Int)

anotado1 (H x) = H (x,0)

anotado1 (N x i d) = aux (N x i d) 0

where aux (H x) n = H (x,n)

aux (N x i d) n = N (x,n) (aux i (n+1)) (aux d (n+1))

-- 2ª solución

anotado2 :: Arbol a -> Arbol (a, Int)

anotado2 a = aux a [0..]

where aux (H a) (n:_ ) = H (a,n)

aux (N a i d) (n:ns) = N (a,n) (aux i ns) (aux d ns)

Números primos de Hilbert

PorJosé A. Alonso 4-febrero-20161-mayo-2016

Un número de Hilbert es un entero positivo de la forma 4n+1. Los primeros números de Hilbert son 1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, 49, 53, 57, 61, 65, 69, …

Un primo de Hilbert es un número de Hilbert n que no es divisible por ningún número de Hilbert menor que n (salvo el 1). Los primeros primos de Hilbert son 5, 9, 13, 17, 21, 29, 33, 37, 41, 49, 53, 57, 61, 69, 73, 77, 89, 93, 97, 101, 109, 113, 121, 129, 133, 137, …

Definir la sucesión

   primosH :: [Integer]

1	primosH :: [Integer]

tal que sus elementos son los primos de Hilbert. Por ejemplo,

   take 15 primosH  == [5,9,13,17,21,29,33,37,41,49,53,57,61,69,73]
   primosH !! 20000 == 203221

1 2	take 15 primosH == [5,9,13,17,21,29,33,37,41,49,53,57,61,69,73] primosH !! 20000 == 203221

Soluciones

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

-- numerosH es la sucesión de los números de Hilbert. Por ejemplo,
--    take 15 numerosH  ==  [1,5,9,13,17,21,25,29,33,37,41,45,49,53,57]
numerosH :: [Integer]
numerosH = [1,5..]

-- (divisoresH n) es la lista de los números de Hilbert que dividen a
-- n. Por ejemplo,
--   divisoresH 117  ==  [1,9,13,117]
--   divisoresH  21  ==  [1,21]
divisoresH :: Integer -> [Integer]
divisoresH n = [x | x <- takeWhile (<=n) numerosH,
                    n `mod` x == 0]

primosH1 :: [Integer]
primosH1 = [n | n <- tail numerosH,
                divisoresH n == [1,n]]

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

primosH2 :: [Integer]
primosH2 = filter esPrimoH (tail numerosH) 
    where esPrimoH n = all noDivideAn [5,9..m]
              where noDivideAn x = n `mod` x /= 0
                    m            = ceiling (sqrt (fromIntegral n))

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

--    λ> primosH1 !! 2000
--    16957
--    (6.93 secs, 750,291,352 bytes)
--    λ> primosH2 !! 2000
--    16957
--    (0.13 secs, 18,066,288 bytes)

-- 1ª definición

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

-- numerosH es la sucesión de los números de Hilbert. Por ejemplo,

-- take 15 numerosH == [1,5,9,13,17,21,25,29,33,37,41,45,49,53,57]

numerosH :: [Integer]

numerosH = [1,5..]

-- (divisoresH n) es la lista de los números de Hilbert que dividen a

-- n. Por ejemplo,

-- divisoresH 117 == [1,9,13,117]

-- divisoresH 21 == [1,21]

divisoresH :: Integer -> [Integer]

divisoresH n = [x | x <- takeWhile (<=n) numerosH,

n `mod` x == 0]

primosH1 :: [Integer]

primosH1 = [n | n <- tail numerosH,

divisoresH n == [1,n]]

-- 2ª definición

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

primosH2 :: [Integer]

primosH2 = filter esPrimoH (tail numerosH)

where esPrimoH n = all noDivideAn [5,9..m]

where noDivideAn x = n `mod` x /= 0

m = ceiling (sqrt (fromIntegral n))

-- Comparación de eficiencia

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

-- λ> primosH1 !! 2000

-- 16957

-- (6.93 secs, 750,291,352 bytes)

-- λ> primosH2 !! 2000

-- 16957

-- (0.13 secs, 18,066,288 bytes)

Ordenación por frecuencia

PorJosé A. Alonso 2-febrero-201625-abril-2021

Definir la función

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

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

tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen menos a los que aparecen más. Por ejemplo,

   ordPorFrecuencia "canalDePanama"  ==  "DPcelmnnaaaaa"
   ordPorFrecuencia "20012016"       ==  "61122000"

1 2	ordPorFrecuencia "canalDePanama" == "DPcelmnnaaaaa" ordPorFrecuencia "20012016" == "61122000"

Soluciones

import Data.List (group, sort)

ordPorFrecuencia :: Ord a => [a] -> [a]
ordPorFrecuencia xs =
    concatMap snd (sort [(length xs,xs) | xs <- group (sort xs)])

import Data.List (group, sort)

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

ordPorFrecuencia xs =

concatMap snd (sort [(length xs,xs) | xs <- group (sort xs)])

Agrupamiento por propiedad

PorJosé A. Alonso 29-enero-20165-febrero-2016

Definir la función

   agrupa :: (a -> Bool) -> [a] -> [[a]]

1	agrupa :: (a -> Bool) -> [a] -> [[a]]

tal que (agrupa p xs) es la lista obtenida separando los elementos consecutivos de xs que verifican la propiedad p de los que no la verifican. Por ejemplo,

   agrupa odd   [1,2,0,4,9,6,4,5,7,2]  ==  [[1],[2,0,4],[9],[6,4],[5,7],[2]]
   agrupa even  [1,2,0,4,9,6,4,5,7,2]  ==  [[],[1],[2,0,4],[9],[6,4],[5,7],[2]]
   agrupa (> 4) [1,2,0,4,9,6,4,5,7,2]  ==  [[],[1,2,0,4],[9,6],[4],[5,7],[2]]
   agrupa (< 4) [1,2,0,4,9,6,4,5,7,2]  ==  [[1,2,0],[4,9,6,4,5,7],[2]]

agrupa odd [1,2,0,4,9,6,4,5,7,2] == [[1],[2,0,4],[9],[6,4],[5,7],[2]]

agrupa even [1,2,0,4,9,6,4,5,7,2] == [[],[1],[2,0,4],[9],[6,4],[5,7],[2]]

agrupa (> 4) [1,2,0,4,9,6,4,5,7,2] == [[],[1,2,0,4],[9,6],[4],[5,7],[2]]

agrupa (< 4) [1,2,0,4,9,6,4,5,7,2] == [[1,2,0],[4,9,6,4,5,7],[2]]

Comprobar con QuickCheck que para cualquier propiedad p y cualquier lista xs, la concatenación de (agrupa p xs) es xs; es decir,

   prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool
   prop_agrupa (Blind p) xs =
       concat (agrupa1 p xs) == xs

prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool

prop_agrupa (Blind p) xs =

concat (agrupa1 p xs) == xs

Nota. Usar la librería Test.QuickCheck.Modifiers.

Soluciones

import Test.QuickCheck
import Test.QuickCheck.Modifiers

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

agrupa1 :: (a -> Bool) -> [a] -> [[a]]
agrupa1 p [] = []
agrupa1 p xs = takeWhile p xs : agrupa1 (not . p) (dropWhile p xs)

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

agrupa2 :: (a -> Bool) -> [a] -> [[a]]
agrupa2 p [] = []
agrupa2 p xs = ys : agrupa2 (not . p) zs
    where (ys,zs) = span p xs

-- Propiedad
-- =========

-- La propiedad es
prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool
prop_agrupa (Blind p) xs =
    concat (agrupa1 p xs) == xs

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

import Test.QuickCheck

import Test.QuickCheck.Modifiers

-- 1ª solución

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

agrupa1 :: (a -> Bool) -> [a] -> [[a]]

agrupa1 p [] = []

agrupa1 p xs = takeWhile p xs : agrupa1 (not . p) (dropWhile p xs)

-- 2ª solución

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

agrupa2 :: (a -> Bool) -> [a] -> [[a]]

agrupa2 p [] = []

agrupa2 p xs = ys : agrupa2 (not . p) zs

where (ys,zs) = span p xs

-- Propiedad

-- =========

-- La propiedad es

prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool

prop_agrupa (Blind p) xs =

concat (agrupa1 p xs) == xs

-- La comprobación es

-- λ> quickCheck prop_agrupa

-- +++ OK, passed 100 tests.

Conjunto de funciones

PorJosé A. Alonso 26-enero-20162-febrero-2016

Una función f entre dos conjuntos A e B se puede representar mediante una lista de pares de AxB tales que para cada elemento a de A existe un único elemento b de B tal que (a,b) pertenece a f. Por ejemplo,

[(1,2),(3,6)] es una función de [1,3] en [2,4,6];
[(1,2)] no es una función de [1,3] en [2,4,6], porque no tiene ningún par cuyo primer elemento sea igual a 3;
[(1,2),(3,6),(1,4)] no es una función porque hay dos pares distintos cuya primer elemento es 1.

Definir la función

   funciones :: [a] -> [a] -> [[(a,a)]]

1	funciones :: [a] -> [a] -> [[(a,a)]]

tal que (funciones xs ys) es el conjunto de las funciones de xs en ys. Por ejemplo,

   λ> funciones [] [2,4,6]
   [[]]
   λ> funciones [3] [2,4,6]
   [[(3,2)],[(3,4)],[(3,6)]]
   λ> funciones [1,3] [2,4,6]
   [[(1,2),(3,2)], [(1,2),(3,4)], [(1,2),(3,6)], [(1,4),(3,2)], [(1,4),(3,4)],
    [(1,4),(3,6)], [(1,6),(3,2)], [(1,6),(3,4)], [(1,6),(3,6)]]

λ> funciones [] [2,4,6]

[[]]

λ> funciones [3] [2,4,6]

[[(3,2)],[(3,4)],[(3,6)]]

λ> funciones [1,3] [2,4,6]

[[(1,2),(3,2)], [(1,2),(3,4)], [(1,2),(3,6)], [(1,4),(3,2)], [(1,4),(3,4)],

[(1,4),(3,6)], [(1,6),(3,2)], [(1,6),(3,4)], [(1,6),(3,6)]]

Comprobar con QuickCheck que si xs es un conjunto con n elementos e ys un conjunto con m elementos, entonces (funciones xs ys) tiene m^n elementos.

Nota. Al hacer la comprobación limitar el tamaño de las pruebas como se indica a continuación

   λ> quickCheckWith (stdArgs {maxSize=7}) prop_funciones
   +++ OK, passed 100 tests.

1 2	λ> quickCheckWith (stdArgs {maxSize=7}) prop_funciones +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

funciones :: [a] -> [a] -> [[(a,a)]]
funciones [] _      = [[]]
funciones (x:xs) ys = [((x,y):f) | y <- ys, f <- fs]
    where fs = funciones xs ys

prop_funciones :: [Int] -> [Int] -> Bool
prop_funciones xs ys =
    length (funciones xs ys) == (length ys)^(length xs)

import Test.QuickCheck

funciones :: [a] -> [a] -> [[(a,a)]]

funciones [] _ = [[]]

funciones (x:xs) ys = [((x,y):f) | y <- ys, f <- fs]

where fs = funciones xs ys

prop_funciones :: [Int] -> [Int] -> Bool

prop_funciones xs ys =

length (funciones xs ys) == (length ys)^(length xs)

Antiimágenes en una función creciente

PorJosé A. Alonso 20-enero-201626-marzo-2022

Definir la función

   antiimagen :: (Int -> Int) -> Int -> Maybe Int

1	antiimagen :: (Int -> Int) -> Int -> Maybe Int

tal que (antiimagen f y) es justo el x tal que f(x) = y, si y pertenece a la imagen de la función creciente f, o nada, en caso contrario. Por ejemplo,

   antiimagen (^2) 25  ==  Just 5
   antiimagen (^3) 25  ==  Nothing

1 2	antiimagen (^2) 25 == Just 5 antiimagen (^3) 25 == Nothing

Nota. Se supone que f está definida sobre los números naturales.

Soluciones

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int
antiimagen1 f y 
    | estaEnImagen f y = Just x
    | otherwise        = Nothing
    where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por
-- ejemplo, 
--    estaEnImagen (^2) 25 == True
--    estaEnImagen (^2) 30 == False
estaEnImagen :: (Int -> Int) -> Int -> Bool
estaEnImagen f y = elem y (takeWhile (<=y) (imagen f)) 

-- (imagen f) es la imagen de f. Por ejemplo,
--    take 10 (imagen (^2))  ==  [0,1,4,9,16,25,36,49,64,81]
--    take 10 (imagen (*3))  ==  [0,3,6,9,12,15,18,21,24,27]
imagen :: (Int -> Int) -> [Int]
imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)
-- =====================================

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int
antiimagen2 f y =
    lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

-- 1ª definición

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

antiimagen1 :: (Int -> Int) -> Int -> Maybe Int

antiimagen1 f y

| estaEnImagen f y = Just x

| otherwise = Nothing

where x = head [x | x <- [0..], f x == y]

-- (estaEnImagen f y) se verifica si pertenece a la imagen de f. Por

-- ejemplo,

-- estaEnImagen (^2) 25 == True

-- estaEnImagen (^2) 30 == False

estaEnImagen :: (Int -> Int) -> Int -> Bool

estaEnImagen f y = elem y (takeWhile (<=y) (imagen f))

-- (imagen f) es la imagen de f. Por ejemplo,

-- take 10 (imagen (^2)) == [0,1,4,9,16,25,36,49,64,81]

-- take 10 (imagen (*3)) == [0,3,6,9,12,15,18,21,24,27]

imagen :: (Int -> Int) -> [Int]

imagen f = map f [0..]

-- 2ª definición (con lookup y maxBound)

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

antiimagen2 :: (Int -> Int) -> Int -> Maybe Int

antiimagen2 f y =

lookup y (takeWhile (<= (y,maxBound)) [(f x, x) | x <- [0..]])

Relleno de matrices

PorJosé A. Alonso 19-enero-201626-enero-2016

Dada una matriz cuyos elementos son 0 ó 1, su relleno es la matriz obtenida haciendo iguales a 1 los elementos de las filas y de las columna que contienen algún uno. Por ejemplo, el relleno de la matriz de la izquierda es la de la derecha:

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

0 0 0 0 0 1 0 0 1 0

0 0 0 1 0 1 1 1 1 1

1 0 0 0 0 1 1 1 1 1

0 0 0 0 0 1 0 0 1 0

Las matrices se pueden representar mediante tablas cuyos índices son pares de enteros

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

por ejemplo, la matriz de la izquierda de la figura anterior se define por

   ej :: Matriz                  
   ej = listArray ((1,1),(5,5)) [0, 0, 0, 0, 0,
                                 0, 0, 0, 0, 0,
                                 0, 0, 0, 1, 0,
                                 1, 0, 0, 0, 0,
                                 0, 0, 0, 0, 0]

ej :: Matriz

ej = listArray ((1,1),(5,5)) [0, 0, 0, 0, 0,

0, 0, 0, 0, 0,

0, 0, 0, 1, 0,

1, 0, 0, 0, 0,

0, 0, 0, 0, 0]

Definir la función

   relleno :: Matriz -> Matriz

1	relleno :: Matriz -> Matriz

tal que (relleno p) es el relleno de la matriz p. Por ejemplo,

   λ> elems (relleno ej)
   [1,0,0,1,0,
    1,0,0,1,0,
    1,1,1,1,1,
    1,1,1,1,1,
    1,0,0,1,0]

λ> elems (relleno ej)

[1,0,0,1,0,

1,0,0,1,0,

1,1,1,1,1,

1,0,0,1,0]

Soluciones

import Data.Array

type Matriz = Array (Int,Int) Int

ej :: Matriz                  
ej = listArray ((1,1),(5,5)) [0, 0, 0, 0, 0,
                              0, 0, 0, 0, 0,
                              0, 0, 0, 1, 0,
                              1, 0, 0, 0, 0,
                              0, 0, 0, 0, 0]

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

relleno1 :: Matriz -> Matriz
relleno1 p = 
    array ((1,1),(m,n)) [((i,j),f i j) | i <- [1..m], j <- [1..n]]
    where (_,(m,n)) = bounds p
          f i j | 1 `elem` [p!(i,k) | k <- [1..n]] = 1
                | 1 `elem` [p!(k,j) | k <- [1..m]] = 1
                | otherwise                        = 0

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

relleno2 :: Matriz -> Matriz
relleno2 p = 
    array ((1,1),(m,n)) [((i,j),f i j) | i <- [1..m], j <- [1..n]]
    where (_,(m,n)) = bounds p
          filas     = filasConUno p
          columnas  = columnasConUno p
          f i j | i `elem` filas    = 1
                | j `elem` columnas = 1
                | otherwise         = 0

-- (filasConUno p) es la lista de las filas de p que tienen algún
-- uno. Por ejemplo,
--    filasConUno ej  ==  [3,4]
filasConUno :: Matriz -> [Int]
filasConUno p = [i | i <- [1..m], filaConUno p i]
    where (_,(m,n)) = bounds p

-- (filaConUno p i) se verifica si p tiene algún uno en la fila i. Por
-- ejemplo, 
--    filaConUno ej 3  ==  True
--    filaConUno ej 2  ==  False
filaConUno :: Matriz -> Int -> Bool
filaConUno p i = any (==1) [p!(i,j) | j <- [1..n]]
    where (_,(_,n)) = bounds p

-- (columnasConUno p) es la lista de las columnas de p que tienen algún
-- uno. Por ejemplo,
--    columnasConUno ej  ==  [1,4]
columnasConUno :: Matriz -> [Int]
columnasConUno p = [j | j <- [1..n], columnaConUno p j]
    where (_,(m,n)) = bounds p

-- (columnaConUno p i) se verifica si p tiene algún uno en la columna i. Por
-- ejemplo, 
--    columnaConUno ej 1  ==  True
--    columnaConUno ej 2  ==  False
columnaConUno :: Matriz -> Int -> Bool
columnaConUno p j = any (==1) [p!(i,j) | i <- [1..m]]
    where (_,(m,_)) = bounds p

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

relleno3 :: Matriz -> Matriz
relleno3 p = p // ([((i,j),1) | i <- filas,  j <- [1..n]] ++ 
                   [((i,j),1) | i <- [1..m], j <- columnas])
  where (_,(m,n)) = bounds p
        filas     = filasConUno p
        columnas  = columnasConUno p


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

--    λ> let f i j = if i == j then 1 else 0 
--    λ> let q n = array ((1,1),(n,n)) [((i,j),f i j) | i <- [1..n], j <- [1..n]]
--    
--    λ> sum (elems (relleno1 (q 200)))
--    40000
--    (6.90 secs, 1,877,369,544 bytes)
--    
--    λ> sum (elems (relleno2 (q 200)))
--    40000
--    (0.46 secs, 57,354,168 bytes)
--    
--    λ> sum (elems (relleno3 (q 200)))
--    40000
--    (0.34 secs, 80,465,144 bytes)
--    
--    λ> sum (elems (relleno2 (q 500)))
--    250000
--    (4.33 secs, 353,117,640 bytes)
--    
--    λ> sum (elems (relleno3 (q 500)))
--    250000
--    (2.40 secs, 489,630,048 bytes)

100

101

import Data.Array

type Matriz = Array (Int,Int) Int

ej :: Matriz

ej = listArray ((1,1),(5,5)) [0, 0, 0, 0, 0,

0, 0, 0, 0, 0,

0, 0, 0, 1, 0,

1, 0, 0, 0, 0,

0, 0, 0, 0, 0]

-- 1ª solución

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

relleno1 :: Matriz -> Matriz

relleno1 p =

array ((1,1),(m,n)) [((i,j),f i j) | i <- [1..m], j <- [1..n]]

where (_,(m,n)) = bounds p

f i j | 1 `elem` [p!(i,k) | k <- [1..n]] = 1

| 1 `elem` [p!(k,j) | k <- [1..m]] = 1

| otherwise = 0

-- 2ª solución

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

relleno2 :: Matriz -> Matriz

relleno2 p =

array ((1,1),(m,n)) [((i,j),f i j) | i <- [1..m], j <- [1..n]]

where (_,(m,n)) = bounds p

filas = filasConUno p

columnas = columnasConUno p

f i j | i `elem` filas = 1

| j `elem` columnas = 1

| otherwise = 0

-- (filasConUno p) es la lista de las filas de p que tienen algún

-- uno. Por ejemplo,

-- filasConUno ej == [3,4]

filasConUno :: Matriz -> [Int]

filasConUno p = [i | i <- [1..m], filaConUno p i]

where (_,(m,n)) = bounds p

-- (filaConUno p i) se verifica si p tiene algún uno en la fila i. Por

-- ejemplo,

-- filaConUno ej 3 == True

-- filaConUno ej 2 == False

filaConUno :: Matriz -> Int -> Bool

filaConUno p i = any (==1) [p!(i,j) | j <- [1..n]]

where (_,(_,n)) = bounds p

-- (columnasConUno p) es la lista de las columnas de p que tienen algún

-- uno. Por ejemplo,

-- columnasConUno ej == [1,4]

columnasConUno :: Matriz -> [Int]

columnasConUno p = [j | j <- [1..n], columnaConUno p j]

where (_,(m,n)) = bounds p

-- (columnaConUno p i) se verifica si p tiene algún uno en la columna i. Por

-- ejemplo,

-- columnaConUno ej 1 == True

-- columnaConUno ej 2 == False

columnaConUno :: Matriz -> Int -> Bool

columnaConUno p j = any (==1) [p!(i,j) | i <- [1..m]]

where (_,(m,_)) = bounds p

-- 3ª solución

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

relleno3 :: Matriz -> Matriz

relleno3 p = p // ([((i,j),1) | i <- filas, j <- [1..n]] ++

[((i,j),1) | i <- [1..m], j <- columnas])

where (_,(m,n)) = bounds p

filas = filasConUno p

columnas = columnasConUno p

-- Comparación de eficiencia

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

-- λ> let f i j = if i == j then 1 else 0

-- λ> let q n = array ((1,1),(n,n)) [((i,j),f i j) | i <- [1..n], j <- [1..n]]

-- λ> sum (elems (relleno1 (q 200)))

-- 40000

-- (6.90 secs, 1,877,369,544 bytes)

-- λ> sum (elems (relleno2 (q 200)))

-- 40000

-- (0.46 secs, 57,354,168 bytes)

-- λ> sum (elems (relleno3 (q 200)))

-- 40000

-- (0.34 secs, 80,465,144 bytes)

-- λ> sum (elems (relleno2 (q 500)))

-- 250000

-- (4.33 secs, 353,117,640 bytes)

-- λ> sum (elems (relleno3 (q 500)))

-- 250000

-- (2.40 secs, 489,630,048 bytes)

Referencias

Basado en Matrix Fill-In del blog Programming Praxis.

Primos que contienen al 2016

PorJosé A. Alonso 18-enero-201625-enero-2016

Definir la sucesión

   primosCon2016 :: [Integer]

1	primosCon2016 :: [Integer]

tal que sus elementos son los números primos que contienen al 2016. Por ejemplo,

   take 5 primosCon2016  ==  [20161,120163,120167,201611,201623]
   primosCon2016 !! 111  ==  3020167

1 2	take 5 primosCon2016 == [20161,120163,120167,201611,201623] primosCon2016 !! 111 == 3020167

Soluciones

import Data.List (isInfixOf)
import Data.Numbers.Primes (primes)

primosCon2016 :: [Integer]
primosCon2016 = 
    [x | x <- primes, isInfixOf "2016" (show x)]

import Data.List (isInfixOf)

import Data.Numbers.Primes (primes)

primosCon2016 :: [Integer]

primosCon2016 =

[x | x <- primes, isInfixOf "2016" (show x)]

Referencias

Basado en el artículo Prime numbers containing 2016 del blog Fun With Num3ers.

Puntos visibles en la cuadrícula de un plano

PorJosé A. Alonso 13-enero-20161-mayo-2016

La cuadrícula entera de lado n, Cₙ, es el conjunto de los puntos (x,y) donde x e y son números enteros tales que 1 ≤ x, y ≤ n.

Un punto (x,y) de Cₙ es visible desde el origen si el máximo común divisor de x e y es 1. Por ejemplo, el punto (4,6) no es visible porque está ocultado por el (2,3); en cambio, el (2,3) sí es visible.

El conjunto de los puntos visibles en la cuadrícula entera de lado 6 son (1,1), (1,2), (1,3), (1,4), (1,5), (1,6), (2,1), (2,3), (2,5), (3,1), (3,2), (3,4), (3,5), (4,1), (4,3), (4,5), (5,1), (5,2), (5,3), (5,4), (5,6), (6,1) y (6,5).

Definir la función

   nVisibles :: Integer -> Integer

1	nVisibles :: Integer -> Integer

tal que (nVisibles n) es el número de los puntos visibles en la cuadrícula de lado n.Por ejemplo,

   nVisibles 6       ==  23
   nVisibles 10      ==  63
   nVisibles 100     ==  6087
   nVisibles 1000    ==  608383
   nVisibles 10000   ==  60794971
   nVisibles 100000  ==  6079301507

nVisibles 6 == 23

nVisibles 10 == 63

nVisibles 100 == 6087

nVisibles 1000 == 608383

nVisibles 10000 == 60794971

nVisibles 100000 == 6079301507

Soluciones

import Data.List (genericLength, group, sort)
import Data.Numbers.Primes (primeFactors)

type Punto = (Integer,Integer)

-- (visible p) se verifica si el punto p es visible. Por ejemplo,
--    visible (4,5)  ==  True
--    visible (4,6)  ==  False
visible :: Punto -> Bool
visible (x,y) = gcd x y == 1

-- (visibles n) es el conjunto de los puntos visibles en la cuadrícula
-- de lado 1. Por ejemplo,
-- cuadrado 1 <= x, y <= n. Por ejemplo,
--    λ> sort (visibles 6)
--    [(1,1),(1,2),(1,3),(1,4),(1,5),(1,6),(2,1),(2,3),(2,5),(3,1),(3,2),(3,4),
--     (3,5),(4,1),(4,3),(4,5),(5,1),(5,2),(5,3),(5,4),(5,6),(6,1),(6,5)]

-- 1ª definición de visibles
visibles1 :: Integer -> [Punto]
visibles1 n = [(x,y) | x <- [1..n], y <- [1..n], visible (x,y)]

-- 2ª definición de visibles
visibles2 :: Integer -> [Punto]
visibles2 n = (1,1) : ps ++ [(y,x) | (x,y) <- ps] 
    where ps = [(x,y) | x <- [1..n], y <- [x+1..n], visible (x,y)]

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

--    λ> length (visibles1 1000)
--    608383
--    (3.40 secs, 758,346,208 bytes)
--    λ> length (visibles2 1000)
--    608383
--    (2.22 secs, 464,276,856 bytes)

-- Usaremos la 2ª definición de visibles
visibles :: Integer -> [Punto]
visibles = visibles2

-- 1ª definición de nVisibles
nVisibles1 :: Integer -> Integer
nVisibles1 = genericLength . visibles


-- 2ª definición de nVisibles
nVisibles2 :: Integer -> Integer
nVisibles2 n = 
    1 + 2 * genericLength [(x,y) | x <- [1..n], 
                                   y <- [x+1..n], 
                                   visible (x,y)]

-- 3ª definición de nVisibles
nVisibles3 :: Integer -> Integer
nVisibles3 1 = 1
nVisibles3 n = nVisibles3 (n-1) + (2 * phi n)

-- La función φ de Euler (del ejercicio anterior).
phi :: Integer -> Integer
phi n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n] 
    
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- 4ª definición de nVisibles
nVisibles4 :: Integer -> Integer
nVisibles4 n = 2 * sum [phi x | x <- [1..n]] - 1

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

--    λ> nVisibles1 1000
--    608383
--    (2.69 secs, 521,599,512 bytes)
--    λ> nVisibles2 1000
--    608383
--    λ> nVisibles3 1000
--    608383
--    (0.05 secs, 0 bytes)
--    λ> nVisibles4 1000
--    608383
--    (0.04 secs, 0 bytes)

import Data.List (genericLength, group, sort)

import Data.Numbers.Primes (primeFactors)

type Punto = (Integer,Integer)

-- (visible p) se verifica si el punto p es visible. Por ejemplo,

-- visible (4,5) == True

-- visible (4,6) == False

visible :: Punto -> Bool

visible (x,y) = gcd x y == 1

-- (visibles n) es el conjunto de los puntos visibles en la cuadrícula

-- de lado 1. Por ejemplo,

-- cuadrado 1 <= x, y <= n. Por ejemplo,

-- λ> sort (visibles 6)

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

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

-- 1ª definición de visibles

visibles1 :: Integer -> [Punto]

visibles1 n = [(x,y) | x <- [1..n], y <- [1..n], visible (x,y)]

-- 2ª definición de visibles

visibles2 :: Integer -> [Punto]

visibles2 n = (1,1) : ps ++ [(y,x) | (x,y) <- ps]

where ps = [(x,y) | x <- [1..n], y <- [x+1..n], visible (x,y)]

-- Comparación de eficiencia

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

-- λ> length (visibles1 1000)

-- 608383

-- (3.40 secs, 758,346,208 bytes)

-- λ> length (visibles2 1000)

-- 608383

-- (2.22 secs, 464,276,856 bytes)

-- Usaremos la 2ª definición de visibles

visibles :: Integer -> [Punto]

visibles = visibles2

-- 1ª definición de nVisibles

nVisibles1 :: Integer -> Integer

nVisibles1 = genericLength . visibles

-- 2ª definición de nVisibles

nVisibles2 :: Integer -> Integer

nVisibles2 n =

1 + 2 * genericLength [(x,y) | x <- [1..n],

y <- [x+1..n],

visible (x,y)]

-- 3ª definición de nVisibles

nVisibles3 :: Integer -> Integer

nVisibles3 1 = 1

nVisibles3 n = nVisibles3 (n-1) + (2 * phi n)

-- La función φ de Euler (del ejercicio anterior).

phi :: Integer -> Integer

phi n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion n =

[(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- 4ª definición de nVisibles

nVisibles4 :: Integer -> Integer

nVisibles4 n = 2 * sum [phi x | x <- [1..n]] - 1

-- Comparación de eficiencia

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

-- λ> nVisibles1 1000

-- 608383

-- (2.69 secs, 521,599,512 bytes)

-- λ> nVisibles2 1000

-- 608383

-- λ> nVisibles3 1000

-- 608383

-- (0.05 secs, 0 bytes)

-- λ> nVisibles4 1000

-- 608383

-- (0.04 secs, 0 bytes)

Referencias

N.J.A. Sloane, Sucesión A018805 en OEIS.

Puntos en una región

PorJosé A. Alonso 5-enero-20161-mayo-2016

Definir la función

   puntos :: Integer -> [(Integer,Integer)]

1	puntos :: Integer -> [(Integer,Integer)]

tal que (puntos n) es la lista de los puntos (x,y) con coordenadas enteras de
la cuadrícula [1..n]x[1..n] (es decir, 1 ≤ x,y ≤ n) tales que |x²-xy-y²| = 1. Por ejemplo,

   length (puntos 10)          ==  5
   length (puntos 100)         ==  10
   length (puntos 1000)        ==  15
   length (puntos (10^50000))  ==  239249

length (puntos 10) == 5

length (puntos 100) == 10

length (puntos 1000) == 15

length (puntos (10^50000)) == 239249

Soluciones

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

puntos1 :: Integer -> [(Integer,Integer)]
puntos1 n =
    [(x,y) | x <- [1..n],
             y <- [1..n],
             abs (x^2-x*y-y^2) == 1] 

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

-- Calculando algunos elementos
--    λ> puntos1 10
--    [(1,1),(2,1),(3,2),(5,3),(8,5)]
--    λ> puntos1 20
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]
--    λ> puntos1 100
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
--    λ> puntos1 89
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
-- se observa una ley de construcción de cada elemento a partir del anterior.

puntos2 :: Integer -> [(Integer,Integer)]
puntos2 n = takeWhile menor (iterate siguiente (1,1))
    where siguiente (x,y) = (x+y,x)
          menor (x,y)     = x <= n

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

-- Se observa que la lista de las segundas componentes
--    1,1,2,3,5,8,13,21,34,55,89,...
-- y la lista de las primeras componentes es el resto de la segunda. 

puntos3 :: Integer -> [(Integer,Integer)]
puntos3 n = zip (tail xs) xs
    where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,
--    take 11 fibonacci  ==  [1,1,2,3,5,8,13,21,34,55,89]
fibonacci :: [Integer]
fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

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

-- λ> length (puntos1 (10^3))
-- 15
-- (7.96 secs, 1,092,368,200 bytes)
-- λ> length (puntos2 (10^3))
-- 15
-- (0.02 secs, 0 bytes)
-- 
-- λ> length (puntos2 (10^30000))
-- 143549
-- (1.14 secs, 974,239,544 bytes)
-- λ> length (puntos3 (10^30000))
-- 143549
-- (3.28 secs, 967,206,560 bytes)

-- 1ª definición

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

puntos1 :: Integer -> [(Integer,Integer)]

puntos1 n =

[(x,y) | x <- [1..n],

y <- [1..n],

abs (x^2-x*y-y^2) == 1]

-- 2ª definición

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

-- Calculando algunos elementos

-- λ> puntos1 10

-- [(1,1),(2,1),(3,2),(5,3),(8,5)]

-- λ> puntos1 20

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]

-- λ> puntos1 100

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- λ> puntos1 89

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- se observa una ley de construcción de cada elemento a partir del anterior.

puntos2 :: Integer -> [(Integer,Integer)]

puntos2 n = takeWhile menor (iterate siguiente (1,1))

where siguiente (x,y) = (x+y,x)

menor (x,y) = x <= n

-- 3ª definición

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

-- Se observa que la lista de las segundas componentes

-- 1,1,2,3,5,8,13,21,34,55,89,...

-- y la lista de las primeras componentes es el resto de la segunda.

puntos3 :: Integer -> [(Integer,Integer)]

puntos3 n = zip (tail xs) xs

where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,

-- take 11 fibonacci == [1,1,2,3,5,8,13,21,34,55,89]

fibonacci :: [Integer]

fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

-- Comparación de eficiencia

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

-- λ> length (puntos1 (10^3))

-- 15

-- (7.96 secs, 1,092,368,200 bytes)

-- λ> length (puntos2 (10^3))

-- 15

-- (0.02 secs, 0 bytes)

-- λ> length (puntos2 (10^30000))

-- 143549

-- (1.14 secs, 974,239,544 bytes)

-- λ> length (puntos3 (10^30000))

-- 143549

-- (3.28 secs, 967,206,560 bytes)

2016 es un número práctico

PorJosé A. Alonso 4-enero-20161-mayo-2016

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

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

esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))

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

esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1

esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo, 
--    factorizacion  600  ==  [(2,3),(3,1),(5,2)]
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]

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

--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

import Data.List (genericLength, group, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

takeWhile (<n) (sumas (divisores n)) == [0..n-1]

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

-- divisores 12 == [1,2,3,4,6]

-- divisores 14 == [1,2,7]

divisores :: Integer -> [Integer]

divisores n = [k | k <- [1..n-1], n `mod` k == 0]

-- (sumas xs) es la lista ordenada de números que se pueden obtener como

-- sumas de elementos de xs sin usar ningún elemento más de una vez en

-- cada suma. Por ejemplo,

-- sumas [1,2,3] == [0,1,2,3,4,5,6]

-- sumas [1,2,7] == [0,1,2,3,7,8,9,10]

sumas :: [Integer] -> [Integer]

sumas xs = sort (nub (map sum (subsequences xs)))

-- 2ª definición

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

esPractico2 :: Integer -> Bool

esPractico2 n = all (esSumable (divisores n)) [1..n-1]

-- (esSumable xs n) se verifica si n se puede escribir como una suma de

-- elementos distintos de la lista creciente xs. Por ejemplo,

-- esSumable [1,2,7] 8 == True

-- esSumable [1,2,7] 6 == False

-- esSumable [1,2,7] 4 == False

-- esSumable [1,2,7] 2 == True

-- esSumable [1,2,7] 0 == True

esSumable :: [Integer] -> Integer -> Bool

esSumable _ 0 = True

esSumable [] _ = False

esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)

-- 3ª definición

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

-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2

-- es práctico syss para su factorización prima

-- n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)

-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que

-- 1+e(j)

-- i-1 p(j) - 1

-- p(i) <= 1 + ∏ ----------------

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

and [p <= 1 + c | (p,c) <- zip bases cotas]

where xss = factorizacion n

(x:bases) = map fst xss

cotas = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]

-- (factorizacion n) es la factorización de n. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

-- factorizacion 1400 == [(2,3),(5,2),(7,1)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion n =

[(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Comparación de eficiencia

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

-- λ> length [n | n <- [1..400], esPractico1 n]

-- 92

-- (40.21 secs, 8,378,539,464 bytes)

-- λ> length [n | n <- [1..400], esPractico2 n]

-- 92

-- (8.29 secs, 1,109,669,760 bytes)

-- λ> length [n | n <- [1..400], esPractico3 n]

-- 92

-- (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias

M. Margenstern (1991), Les nombres pratiques: théorie, observations et conjectures.
G. Melfi, Practical numbers.
G. Melfi (2008), A survey on practical numbers.
OEIS, Sucesión A005153.
PlanetMath.org, Practical number.
E.W. Weisstein, Practical number.
A. Weingartner (2015), Practical numbers and the distribution of divisors.
Wikipedia, Practical number.

Suma con redondeos

PorJosé A. Alonso 1-enero-20167-enero-2016

Definir las funciones

   sumaRedondeos       :: Integer -> [Integer]
   limiteSumaRedondeos :: Integer -> Integer

1 2	sumaRedondeos :: Integer -> [Integer] limiteSumaRedondeos :: Integer -> Integer

tales que

(sumaRedondeos n) es la sucesión cuyo k-ésimo término es

     redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

1	redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

Por ejemplo,

     take 5 (sumaRedondeos 1000)  ==  [500,750,875,937,968]

1	take 5 (sumaRedondeos 1000) == [500,750,875,937,968]

(limiteSumaRedondeos n) es la suma de la serie

     redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

1	redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

Por ejemplo,

     limiteSumaRedondeos 2000                    ==  1999
     limiteSumaRedondeos 2016                    ==  2016
     limiteSumaRedondeos (10^308) `mod` (10^10)  ==  123839487

limiteSumaRedondeos 2000 == 1999

limiteSumaRedondeos 2016 == 2016

limiteSumaRedondeos (10^308) `mod` (10^10) == 123839487

Soluciones

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

sumaRedondeos1 :: Integer -> [Integer]
sumaRedondeos1 n =
    [sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer
limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer
limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición
sumaRedondeos2 :: Integer -> [Integer]
sumaRedondeos2 n =
    scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer
limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición
sumaRedondeos3 :: Integer -> [Integer]
sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))
    where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)
          n'      = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer
limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición
sumaRedondeos4 :: Integer -> [Integer]
sumaRedondeos4 n = xs ++ repeat x
    where n' = fromIntegral n
          m  = round (logBase 2 n')
          xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
          x  = last xs

limiteSumaRedondeos4 :: Integer -> Integer
limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia
--    λ> (sumaRedondeos1 4) !! 20000
--    3
--    (0.92 secs, 197,782,232 bytes)
--    λ> (sumaRedondeos1 4) !! 30000
--    3
--    (2.20 secs, 351,084,816 bytes)
--    λ> (sumaRedondeos3 4) !! 20000
--    3
--    (0.30 secs, 53,472,392 bytes)
--    λ> (sumaRedondeos4 4) !! 20000
--    3
--    (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición
sumaRedondeos :: Integer -> [Integer]
sumaRedondeos = sumaRedondeos3

-- 5ª definición
-- =============

limiteSumaRedondeos5 :: Integer -> Integer
limiteSumaRedondeos5 n = 
    sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
    where n' = fromIntegral n
          m  = round (logBase 2 n')

-- 1ª definición

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

sumaRedondeos1 :: Integer -> [Integer]

sumaRedondeos1 n =

[sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer

limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer

limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición

sumaRedondeos2 :: Integer -> [Integer]

sumaRedondeos2 n =

scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer

limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición

sumaRedondeos3 :: Integer -> [Integer]

sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))

where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)

n' = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer

limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición

sumaRedondeos4 :: Integer -> [Integer]

sumaRedondeos4 n = xs ++ repeat x

where n' = fromIntegral n

m = round (logBase 2 n')

xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

x = last xs

limiteSumaRedondeos4 :: Integer -> Integer

limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia

-- λ> (sumaRedondeos1 4) !! 20000

-- 3

-- (0.92 secs, 197,782,232 bytes)

-- λ> (sumaRedondeos1 4) !! 30000

-- 3

-- (2.20 secs, 351,084,816 bytes)

-- λ> (sumaRedondeos3 4) !! 20000

-- 3

-- (0.30 secs, 53,472,392 bytes)

-- λ> (sumaRedondeos4 4) !! 20000

-- 3

-- (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición

sumaRedondeos :: Integer -> [Integer]

sumaRedondeos = sumaRedondeos3

-- 5ª definición

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

limiteSumaRedondeos5 :: Integer -> Integer

limiteSumaRedondeos5 n =

sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

where n' = fromIntegral n

m = round (logBase 2 n')

Inserciones por posición

PorJosé A. Alonso 25-diciembre-20151-enero-2016

Definir la función

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

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

tal que (inserta xs yss) es la lista obtenida insertando

el primer elemento de xs como primero en la primera lista de yss,
el segundo elemento de xs como segundo en la segunda lista de yss (si la segunda lista de yss tiene al menos un elemento),
el tercer elemento de xs como tercero en la tercera lista de yss (si la tercera lista de yss tiene al menos dos elementos),

y así sucesivamente. Por ejemplo,

   inserta [1,2,3] [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,3,8]]
   inserta [1,2,3] [[4,7],[] ,[9,5,8]]  ==  [[1,4,7],[],   [9,5,3,8]]
   inserta [1,2]   [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,8]]
   inserta [1,2,3] [[4,7],[6]]          ==  [[1,4,7],[6,2]]
   inserta "tad"   ["odo","pra","naa"]  ==  ["todo","para","nada"]

inserta [1,2,3] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,3,8]]

inserta [1,2,3] [[4,7],[] ,[9,5,8]] == [[1,4,7],[], [9,5,3,8]]

inserta [1,2] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,8]]

inserta [1,2,3] [[4,7],[6]] == [[1,4,7],[6,2]]

inserta "tad" ["odo","pra","naa"] == ["todo","para","nada"]

Nota: Este ejercicio es parte del examen del grupo 2 del 4 de diciembre.

Soluciones

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

inserta :: [a] -> [[a]] -> [[a]]
inserta xs yss = aux xs yss 0 where
    aux [] yss _ = yss
    aux xs []  _ = []
    aux (x:xs) (ys:yss) n 
        | length us == n = (us ++ x : vs) : aux xs yss (n+1)
        | otherwise      = ys : aux xs yss (n+1)
        where (us,vs) = splitAt n ys

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

inserta2 :: [a] -> [[a]] -> [[a]]
inserta2 xs yss =  
    [ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss
 
ins :: Int -> a -> [a] -> [a]
ins n x ys | length ys < n  = ys
           | otherwise      = take n ys ++ x : drop n ys

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

--    λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))
--    10000
--    (3.28 secs, 6,400,568,776 bytes)
--    λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))
--    10000
--    (0.02 secs, 0 bytes)

-- 1ª solución

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

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

inserta xs yss = aux xs yss 0 where

aux [] yss _ = yss

aux xs [] _ = []

aux (x:xs) (ys:yss) n

| length us == n = (us ++ x : vs) : aux xs yss (n+1)

| otherwise = ys : aux xs yss (n+1)

where (us,vs) = splitAt n ys

-- 2ª solución

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

inserta2 :: [a] -> [[a]] -> [[a]]

inserta2 xs yss =

[ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss

ins :: Int -> a -> [a] -> [a]

ins n x ys | length ys < n = ys

| otherwise = take n ys ++ x : drop n ys

-- Comparación de eficiencia

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

-- λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))

-- 10000

-- (3.28 secs, 6,400,568,776 bytes)

-- λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))

-- 10000

-- (0.02 secs, 0 bytes)

Árbol de Navidad

PorJosé A. Alonso 24-diciembre-201531-diciembre-2015

Definir el procedimiento

   arbol :: Int -> IO ()

1	arbol :: Int -> IO ()

tal que (arbol n) dibuja el árbol de Navidad con una copa de altura n y un tronco de altura la mitad de n. Por ejemplo,

   λ> arbol 5
   
        X
       XXX
      XXXXX
     XXXXXXX
    XXXXXXXXX
        X
        X
   
   λ> arbol 6
   
         X
        XXX
       XXXXX
      XXXXXXX
     XXXXXXXXX
    XXXXXXXXXXX
         X
         X
         X
   
   λ> arbol 7
   
          X
         XXX
        XXXXX
       XXXXXXX
      XXXXXXXXX
     XXXXXXXXXXX
    XXXXXXXXXXXXX
          X
          X
          X

λ> arbol 5

XXX

XXXXX

XXXXXXX

XXXXXXXXX

λ> arbol 6

XXX

XXXXX

XXXXXXX

XXXXXXXXX

XXXXXXXXXXX

λ> arbol 7

XXX

XXXXX

XXXXXXX

XXXXXXXXX

XXXXXXXXXXX

XXXXXXXXXXXXX

Soluciones

arbol :: Int -> IO ()
arbol n = do
  putStrLn ""
  sequence_ [putStrLn c | c <- triangulo n]
  sequence_ [putStrLn c | c <- rectangulo n]
  putStrLn ""

triangulo :: Int -> [String]
triangulo n =
    [replicate (n-k) ' ' ++ replicate (1+2*k) 'X' | k <- [0..n-1]]

rectangulo :: Int -> [String]
rectangulo n =
    [replicate n ' ' ++ "X" | _ <- [1..n `div` 2]]

arbol :: Int -> IO ()

arbol n = do

putStrLn ""

sequence_ [putStrLn c | c <- triangulo n]

sequence_ [putStrLn c | c <- rectangulo n]

putStrLn ""

triangulo :: Int -> [String]

triangulo n =

[replicate (n-k) ' ' ++ replicate (1+2*k) 'X' | k <- [0..n-1]]

rectangulo :: Int -> [String]

rectangulo n =

[replicate n ' ' ++ "X" | _ <- [1..n `div` 2]]

Listas hermanadas

PorJosé A. Alonso 21-diciembre-201528-diciembre-2015

Una lista hermanada es una lista de números estrictamente positivos en la que cada elemento tiene algún factor primo en común con el siguiente, en caso de que exista, o alguno de los dos es un 1. Por ejemplo,

[2,6,3,9,1,5] es una lista hermanada pues 2 y 6 tienen un factor en común (2); 6 y 3 tienen un factor en común (3); 3 y 9 tienen un factor en común (3); de 9 y 1 uno es el número 1; y de 1 y 5 uno es el número 1.
[2,3,5] no es una lista hermanada pues 2 y 3 no tienen ningún factor primo en común.

Definir la función

   hermanada :: [Int] -> Bool

1	hermanada :: [Int] -> Bool

tal que (hermanada xs) se verifica si la lista xs es hermanada según la definición anterior. Por ejemplo,

   hermanada [2,6,3,9,1,5]   ==  True
   hermanada [2,3,5]         ==  False
   hermanada [2,4..1000000]  ==  True

hermanada [2,6,3,9,1,5] == True

hermanada [2,3,5] == False

hermanada [2,4..1000000] == True

Nota: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

-- 1ª definición (por comprensión)
hermanada1 :: [Int] -> Bool
hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]

-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es
-- igual a 1 o tienen algún factor primo en común
hermanos :: (Int, Int) -> Bool
hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1

-- 2ª definición (con all)
hermanada2 :: [Int] -> Bool
hermanada2 xs = all hermanos (zip xs (tail xs))

-- 3ª definición (por recursión)
hermanada3 :: [Int] -> Bool
hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)
hermanada3 _          = True

-- 4ª definición (por plegado)
hermanada4 :: [Int] -> Bool
hermanada4 xs =
    foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))

-- Comparación de eficiencia
--    λ> hermanada1 [2,4..1000000]
--    True
--    (2.33 secs, 476,586,552 bytes)
--    λ> hermanada2 [2,4..1000000]
--    True
--    (1.80 secs, 422,879,072 bytes)
--    λ> hermanada3 [2,4..1000000]
--    True
--    (2.58 secs, 477,251,896 bytes)
--    λ> hermanada4 [2,4..1000000]
--    True
--    (2.36 secs, 440,047,520 bytes)

-- 1ª definición (por comprensión)

hermanada1 :: [Int] -> Bool

hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]

-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es

-- igual a 1 o tienen algún factor primo en común

hermanos :: (Int, Int) -> Bool

hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1

-- 2ª definición (con all)

hermanada2 :: [Int] -> Bool

hermanada2 xs = all hermanos (zip xs (tail xs))

-- 3ª definición (por recursión)

hermanada3 :: [Int] -> Bool

hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)

hermanada3 _ = True

-- 4ª definición (por plegado)

hermanada4 :: [Int] -> Bool

hermanada4 xs =

foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))

-- Comparación de eficiencia

-- λ> hermanada1 [2,4..1000000]

-- True

-- (2.33 secs, 476,586,552 bytes)

-- λ> hermanada2 [2,4..1000000]

-- True

-- (1.80 secs, 422,879,072 bytes)

-- λ> hermanada3 [2,4..1000000]

-- True

-- (2.58 secs, 477,251,896 bytes)

-- λ> hermanada4 [2,4..1000000]

-- True

-- (2.36 secs, 440,047,520 bytes)

Factorizable respecto de una lista

PorJosé A. Alonso 16-diciembre-201523-diciembre-2015

Definir la función

   factorizable :: Integer -> [Integer] -> Bool

1	factorizable :: Integer -> [Integer] -> Bool

tal que (factorizable x ys) se verifica si x se puede escribir como producto de potencias de elementos de ys. Por ejemplo,

   factorizable 1  [2,5,6]                           ==  True
   factorizable 12 [2,5,3]                           ==  True
   factorizable 12 [2,5,6]                           ==  True
   factorizable 12 [7,5,12]                          ==  True
   factorizable 12 [2,3,1]                           ==  True
   factorizable 12 [2,3,0]                           ==  True
   factorizable 24 [12,4,6]                          ==  True
   factorizable 0  [2,3,0]                           ==  True
   factorizable 12 [5,6]                             ==  False
   factorizable 12 [2,5,1]                           ==  False
   factorizable 0  [2,3,5]                           ==  False
   factorizable (product [1..3000])     [1..100000]  ==  True
   factorizable (1 + product [1..3000]) [1..100000]  ==  False

factorizable 1 [2,5,6] == True

factorizable 12 [2,5,3] == True

factorizable 12 [2,5,6] == True

factorizable 12 [7,5,12] == True

factorizable 12 [2,3,1] == True

factorizable 12 [2,3,0] == True

factorizable 24 [12,4,6] == True

factorizable 0 [2,3,0] == True

factorizable 12 [5,6] == False

factorizable 12 [2,5,1] == False

factorizable 0 [2,3,5] == False

factorizable (product [1..3000]) [1..100000] == True

factorizable (1 + product [1..3000]) [1..100000] == False

Soluciones

-- 1ª definición
factorizable1 :: Integer -> [Integer] -> Bool
factorizable1 1 _  = True
factorizable1 0 ys = 0 `elem` ys
factorizable1 x ys = 
    or [ factorizable1 (x `div` y) ys | y <- ys
                                       , y /= 0 && y /= 1
                                       , x `mod` y == 0 ]

-- 2ª definición
factorizable2 :: Integer -> [Integer] -> Bool
factorizable2 1 _  = True
factorizable2 0 ys = 0 `elem` ys
factorizable2 x ys = 
    aux x [y | y <- ys, y > 1, x `mod` y == 0]
    where aux _ [] = False
          aux 1 _  = True
          aux x ys | null zs   = False
                   | otherwise = or [aux (x `div` z) ys | z <- zs] 
                   where zs = [y | y <- ys, x `mod` y == 0]

-- 3ª definición
factorizable3 :: Integer -> [Integer] -> Bool
factorizable3 1 _  = True
factorizable3 0 ys = 0 `elem` ys
factorizable3 x ys = 
    aux x [y | y <- ys, y > 1, x `mod` y == 0]
    where aux _ [] = False
          aux 1 _  = True
          aux x (y:ys) 
              | rem x y == 0 = aux (div x y) (y:ys) || aux x ys
              | otherwise    = aux x ys

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

--    λ> factorizable1 (product [1..3000]) [1..100000]
--    True
--    (3.55 secs, 322,471,488 bytes)
--    λ> factorizable2 (product [1..3000]) [1..100000]
--    True
--    (2.46 secs, 274,024,832 bytes)
--    λ> factorizable3 (product [1..3000]) [1..100000]
--    True
--    (0.30 secs, 47,606,400 bytes)
--    
--    λ> factorizable1 (1 + product [1..3000]) [1..100000]
--    False
--    (2.41 secs, 147,221,760 bytes)
--    λ> factorizable2 (1 + product [1..3000]) [1..100000]
--    False
--    (0.45 secs, 40,472,168 bytes)
--    λ> factorizable3 (1 + product [1..3000]) [1..100000]
--    False
--    (0.43 secs, 29,949,680 bytes)

-- 1ª definición

factorizable1 :: Integer -> [Integer] -> Bool

factorizable1 1 _ = True

factorizable1 0 ys = 0 `elem` ys

factorizable1 x ys =

or [ factorizable1 (x `div` y) ys | y <- ys

, y /= 0 && y /= 1

, x `mod` y == 0 ]

-- 2ª definición

factorizable2 :: Integer -> [Integer] -> Bool

factorizable2 1 _ = True

factorizable2 0 ys = 0 `elem` ys

factorizable2 x ys =

aux x [y | y <- ys, y > 1, x `mod` y == 0]

where aux _ [] = False

aux 1 _ = True

aux x ys | null zs = False

| otherwise = or [aux (x `div` z) ys | z <- zs]

where zs = [y | y <- ys, x `mod` y == 0]

-- 3ª definición

factorizable3 :: Integer -> [Integer] -> Bool

factorizable3 1 _ = True

factorizable3 0 ys = 0 `elem` ys

factorizable3 x ys =

aux x [y | y <- ys, y > 1, x `mod` y == 0]

where aux _ [] = False

aux 1 _ = True

aux x (y:ys)

| rem x y == 0 = aux (div x y) (y:ys) || aux x ys

| otherwise = aux x ys

-- Comparación de eficiencia

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

-- λ> factorizable1 (product [1..3000]) [1..100000]

-- True

-- (3.55 secs, 322,471,488 bytes)

-- λ> factorizable2 (product [1..3000]) [1..100000]

-- True

-- (2.46 secs, 274,024,832 bytes)

-- λ> factorizable3 (product [1..3000]) [1..100000]

-- True

-- (0.30 secs, 47,606,400 bytes)

-- λ> factorizable1 (1 + product [1..3000]) [1..100000]

-- False

-- (2.41 secs, 147,221,760 bytes)

-- λ> factorizable2 (1 + product [1..3000]) [1..100000]

-- False

-- (0.45 secs, 40,472,168 bytes)

-- λ> factorizable3 (1 + product [1..3000]) [1..100000]

-- False

-- (0.43 secs, 29,949,680 bytes)

Año cúbico

PorJosé A. Alonso 14-diciembre-201525-marzo-2022

El año 2016 será un año cúbico porque se puede escribir como la suma de los cubos de 7 números consecutivos; en efecto,

   2016 = 3³+ 4³ +...+ 9³

1	2016 = 3³+ 4³ +...+ 9³

Definir la función

   esCubico :: Integer -> Bool

1	esCubico :: Integer -> Bool

tal que (esCubico x) se verifica si x se puede escribir como la suma de los cubos de 7 números consecutivos. Por ejemplo,

   esCubico 2016                ==  True
   esCubico 2017                ==  False
   esCubico 189005670081900441  ==  True
   esCubico 189005670081900442  ==  False

esCubico 2016 == True

esCubico 2017 == False

esCubico 189005670081900441 == True

esCubico 189005670081900442 == False

Soluciones

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

esCubico1 :: Integer -> Bool
esCubico1 x = pertenece x cubicos

-- cubicos es la lista de los números que se pueden escribir como la
-- suma de los cubos de 7 números consecutivos. Por ejemplo,
--    take 5 cubicos  ==  [784,1295,2016,2989,4256]
cubicos :: [Integer]
cubicos = [sum [x^3 | x <- [y..y+6]] | y <- [1..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- ys. Por ejemplo,
--    pertenece 25 [0,3..]  ==  False
--    pertenece 27 [0,3..]  ==  True
pertenece :: Integer -> [Integer] ->  Bool
pertenece x ys = x == head (dropWhile (<x) ys)

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

esCubico2 :: Integer -> Bool
esCubico2 x = pertenece x (cubicosDesde k)
    where k = floor ((fromIntegral x/7)**(1/3))

cubicosDesde :: Integer -> [Integer]
cubicosDesde k = [sum [x^3 | x <- [y..y+6]] | y <- [k..]]

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

--    λ> esCubico1 189005670081900441
--    True
--    (7.49 secs, 1,917,868,024 bytes)
--    λ> esCubico2 189005670081900441
--    True
--    (0.01 secs, 0 bytes)

-- 1ª definición

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

esCubico1 :: Integer -> Bool

esCubico1 x = pertenece x cubicos

-- cubicos es la lista de los números que se pueden escribir como la

-- suma de los cubos de 7 números consecutivos. Por ejemplo,

-- take 5 cubicos == [784,1295,2016,2989,4256]

cubicos :: [Integer]

cubicos = [sum [x^3 | x <- [y..y+6]] | y <- [1..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada

-- ys. Por ejemplo,

-- pertenece 25 [0,3..] == False

-- pertenece 27 [0,3..] == True

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

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

-- 2ª definición

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

esCubico2 :: Integer -> Bool

esCubico2 x = pertenece x (cubicosDesde k)

where k = floor ((fromIntegral x/7)**(1/3))

cubicosDesde :: Integer -> [Integer]

cubicosDesde k = [sum [x^3 | x <- [y..y+6]] | y <- [k..]]

-- Comparación de eficiencia

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

-- λ> esCubico1 189005670081900441

-- True

-- (7.49 secs, 1,917,868,024 bytes)

-- λ> esCubico2 189005670081900441

-- True

-- (0.01 secs, 0 bytes)

Los números de Smith

PorJosé A. Alonso 4-diciembre-201511-diciembre-2015

Un número de Smith es un número natural compuesto que cumple que la suma de sus dígitos es igual a la suma de los dígitos de todos sus factores primos (si tenemos algún factor primo repetido lo sumamos tantas veces como aparezca). Por ejemplo, el 22 es un número de Smith ya que

    22 = 2*11 y
   2+2 = 2+(1+1)

1 2	22 = 2*11 y 2+2 = 2+(1+1)

y el 4937775 también lo es ya que

   4937775       = 3*5*5*65837 y 
   4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

1 2	4937775 = 355*65837 y 4+9+3+7+7+7+5 = 3+5+5+(6+5+8+3+7)

Definir las funciones

   esSmith :: Integer -> Bool
   smith :: [Integer]

1 2	esSmith :: Integer -> Bool smith :: [Integer]

tales que

(esSmith x) se verifica si x es un número de Smith. Por ejemplo,

     esSmith 22          ==  True
     esSmith 29          ==  False
     esSmith 2015        ==  False
     esSmith 4937775     ==  True
     esSmith 4567597056  ==  True

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

smith es la lista cuyos elementos son los números de Smith. Por ejemplo,

     λ> take 17 smith
     [4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]
     λ> smith !! 2000
     62158

λ> take 17 smith

[4,22,27,58,85,94,121,166,202,265,274,319,346,355,378,382,391]

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

esSmith :: Integer -> Bool
esSmith x = 
    not (isPrime x) && 
    sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10 = x
              | otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]
smith = [x | x <- [1..], esSmith x]

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

sumaDigitos x == sum (map sumaDigitos (primeFactors x))

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

| otherwise = x `mod` 10 + sumaDigitos (x `div` 10)

smith :: [Integer]

smith = [x | x <- [1..], esSmith x]

Los números de Armstrong

PorJosé A. Alonso 3-diciembre-201510-diciembre-2015

Un número de n dígitos es un número de Armstrong si es igual a la suma de las n-ésimas potencias de sus dígitos. Por ejemplo, 371, 8208 y 4210818 son números de Armstrong ya que

       371 = 3^3 + 7 + 1³ y  
      8208 = 8^4 + 2^4 + 0^4 + 8^4 
   4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

371 = 3^3 + 7 + 1³ y

8208 = 8^4 + 2^4 + 0^4 + 8^4

4210818 = 4^7 + 2^7 + 1^7 + 0^7 + 8^7 + 1^7 + 8^7

Definir las funciones

   esArmstrong :: Integer -> Bool
   armstrong   :: [Integer]

1 2	esArmstrong :: Integer -> Bool armstrong :: [Integer]

tales que

(esArmstrong x) se verifica si x es un número de Armstrong. Por ejemplo,

     esArmstrong 371                                      ==  True
     esArmstrong 8208                                     ==  True
     esArmstrong 4210818                                  ==  True
     esArmstrong 2015                                     ==  False
     esArmstrong 115132219018763992565095597973971522401  ==  True
     esArmstrong 115132219018763992565095597973971522402  ==  False

esArmstrong 371 == True

esArmstrong 8208 == True

esArmstrong 4210818 == True

esArmstrong 2015 == False

esArmstrong 115132219018763992565095597973971522401 == True

esArmstrong 115132219018763992565095597973971522402 == False

armstrong es la lista cuyos elementos son los números de Armstrong. Por ejemplo,

     λ> take 18 armstrong
     [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

1 2	λ> take 18 armstrong [1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727]

Comprobar con QuickCheck que los números mayores que
115132219018763992565095597973971522401 no son números de Armstrong.

Soluciones

import Test.QuickCheck

esArmstrong :: Integer -> Bool
esArmstrong x = 
    x == sum [d^n | d <- digitos x]
    where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = [read [d] | d <- show x]

armstrong :: [Integer]
armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es
prop_Armstrong :: Integer -> Bool
prop_Armstrong n =
    not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

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

import Test.QuickCheck

esArmstrong :: Integer -> Bool

esArmstrong x =

x == sum [d^n | d <- digitos x]

where n = length (show x)

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos x = [read [d] | d <- show x]

armstrong :: [Integer]

armstrong = [n | n <- [1..], esArmstrong n]

-- La propiedad es

prop_Armstrong :: Integer -> Bool

prop_Armstrong n =

not (esArmstrong (115132219018763992565095597973971522401 + abs n + 1))

-- La comprobación es

-- λ> quickCheck prop_Armstrong

-- +++ OK, passed 100 tests.

Raíces enteras de los números primos

PorJosé A. Alonso 2-diciembre-20151-mayo-2016

Definir la sucesión

   raicesEnterasDePrimos :: [Integer]

1	raicesEnterasDePrimos :: [Integer]

cuyos elementos son las partes enteras de las raíces cuadradas de los números primos. Por ejemplo,

   λ> take 30 raicesEnterasDePrimos
   [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]
   λ> raicesEnterasDePrimos !!  9963
   322
   λ> raicesEnterasDePrimos !!  9964
   323

λ> take 30 raicesEnterasDePrimos

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

λ> raicesEnterasDePrimos !! 9963

322

λ> raicesEnterasDePrimos !! 9964

323

Comprobar con QuickCheck que la diferencia entre dos términos consecutivos de la sucesión es como máximo igual a 1.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck

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

raicesEnterasDePrimos1 :: [Integer]
raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por
-- ejemplo,
--    raizEntera  8  ==  2
--    raizEntera  9  ==  3
--    raizEntera 10  ==  3
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

raicesEnterasDePrimos2 :: [Integer]
raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer
raizEntera2 n = aux 1
    where aux k | k*k > n   = k-1
                | otherwise = aux (k+1)

-- 3º solución
-- ===========

raicesEnterasDePrimos3 :: [Integer]
raicesEnterasDePrimos3 = aux primes [1..]
    where aux (p:ps) (x:xs) | p > x*x   = aux (p:ps) xs
                            | otherwise = (x-1) : aux ps (x:xs)


-- Comparación de eficiencia
--    ghci> raicesEnterasDePrimos1 !! 400000
--    2408
--    (2.86 secs, 1177922500 bytes)
--    ghci> raicesEnterasDePrimos2 !! 400000
--    2408
--    (3.08 secs, 1177432260 bytes)
--    ghci> raicesEnterasDePrimos3 !! 400000
--    2408
--    (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición
raicesEnterasDePrimos :: [Integer]
raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es
prop_raicesEnterasDePrimos :: Int -> Property
prop_raicesEnterasDePrimos n =
    n >= 0 ==> 
    raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

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

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª solución

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

raicesEnterasDePrimos1 :: [Integer]

raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por

-- ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

raicesEnterasDePrimos2 :: [Integer]

raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer

raizEntera2 n = aux 1

where aux k | k*k > n = k-1

| otherwise = aux (k+1)

-- 3º solución

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

raicesEnterasDePrimos3 :: [Integer]

raicesEnterasDePrimos3 = aux primes [1..]

where aux (p:ps) (x:xs) | p > x*x = aux (p:ps) xs

| otherwise = (x-1) : aux ps (x:xs)

-- Comparación de eficiencia

-- ghci> raicesEnterasDePrimos1 !! 400000

-- 2408

-- (2.86 secs, 1177922500 bytes)

-- ghci> raicesEnterasDePrimos2 !! 400000

-- 2408

-- (3.08 secs, 1177432260 bytes)

-- ghci> raicesEnterasDePrimos3 !! 400000

-- 2408

-- (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición

raicesEnterasDePrimos :: [Integer]

raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es

prop_raicesEnterasDePrimos :: Int -> Property

prop_raicesEnterasDePrimos n =

n >= 0 ==>

raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es

-- λ> quickCheck prop_raicesEnterasDePrimos

-- +++ OK, passed 100 tests.

Paridad de un árbol

PorJosé A. Alonso 1-diciembre-20158-diciembre-2015

Los árboles binarios con valores en las hojas y en los nodos se definen por

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

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

/ \

9 7

/ \ / \

1 4 6 8

se puede representar por

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

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

Decimos que un árbol binario es par si la mayoría de sus valores (en nodos u hojas) son pares e impar en caso contrario.

Para representar la paridad se define el tipo Paridad

   data Paridad = Par | Impar deriving (Eq, Show)

1	data Paridad = Par \| Impar deriving (Eq, Show)

Definir la función

   paridad :: Arbol3 Int -> Paridad

1	paridad :: Arbol3 Int -> Paridad

tal que (paridad a) es la paridad del árbol a. Por ejemplo,

   paridad (N 8 (N 6 (H 3) (H 4)) (H 5))  ==  Par
   paridad (N 8 (N 9 (H 3) (H 4)) (H 5))  ==  Impar

1 2	paridad (N 8 (N 6 (H 3) (H 4)) (H 5)) == Par paridad (N 8 (N 9 (H 3) (H 4)) (H 5)) == Impar

Soluciones

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

data Paridad = Par | Impar deriving (Eq, Show)  
 
paridad :: Arbol Int -> Paridad
paridad a | x > y     = Par 
          | otherwise = Impar
          where (x,y) = paridades a

-- (paridades a) es un par (x,y) donde x es el número de valores pares
-- en el árbol a e i es el número de valores impares en el árbol a. Por
-- ejemplo,  
--    paridades (N (N (H 3) 6 (H 4)) 8 (H 5))  ==  (3,2)
--    paridades (N (N (H 3) 9 (H 4)) 8 (H 5))  ==  (2,3)
paridades :: Arbol Int -> (Int,Int)
paridades (H x) | even x    = (1,0)
                | otherwise = (0,1)
paridades (N x i d) | even x    = (1+a1+a2,b1+b2)
                    | otherwise = (a1+a2,1+b1+b2)
                    where (a1,b1) = paridades i
                          (a2,b2) = paridades d

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

data Paridad = Par | Impar deriving (Eq, Show)

paridad :: Arbol Int -> Paridad

paridad a | x > y = Par

| otherwise = Impar

where (x,y) = paridades a

-- (paridades a) es un par (x,y) donde x es el número de valores pares

-- en el árbol a e i es el número de valores impares en el árbol a. Por

-- ejemplo,

-- paridades (N (N (H 3) 6 (H 4)) 8 (H 5)) == (3,2)

-- paridades (N (N (H 3) 9 (H 4)) 8 (H 5)) == (2,3)

paridades :: Arbol Int -> (Int,Int)

paridades (H x) | even x = (1,0)

| otherwise = (0,1)

paridades (N x i d) | even x = (1+a1+a2,b1+b2)

| otherwise = (a1+a2,1+b1+b2)

where (a1,b1) = paridades i

(a2,b2) = paridades d

Separación y mezcla de listas

PorJosé A. Alonso 30-noviembre-20157-diciembre-2015

Definir las funciones

   separacion :: [a] -> ([a],[a])
   mezcla     :: ([a],[a]) -> [a]

1 2	separacion :: [a] -> ([a],[a]) mezcla :: ([a],[a]) -> [a]

tales que (separacion xs) es el par formado eligiendo alternativamente elementos de xs mientras que mezcla intercala los elementos de las dos listas. Por ejemplo,

   separacion [1..5]                   ==  ([1,3,5],[2,4])
   mezcla ([1,3,5],[2,4])              ==  [1,2,3,4,5]
   separacion "Telescopio"             ==  ("Tlsoi","eecpo")
   mezcla ("Tlsoi","eecpo")            ==  "Telescopio"
   take 5 (fst (separacion [2,4..]))   ==  [2,6,10,14,18]
   take 6 (mezcla ([2,4..],[7,14..]))  ==  [2,7,4,14,6,21]

separacion [1..5] == ([1,3,5],[2,4])

mezcla ([1,3,5],[2,4]) == [1,2,3,4,5]

separacion "Telescopio" == ("Tlsoi","eecpo")

mezcla ("Tlsoi","eecpo") == "Telescopio"

take 5 (fst (separacion [2,4..])) == [2,6,10,14,18]

take 6 (mezcla ([2,4..],[7,14..])) == [2,7,4,14,6,21]

Comprobar con QuickCheck que

   mezcla (separacion xs) == xs

1	mezcla (separacion xs) == xs

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
separacion1 :: [a] -> ([a],[a])
separacion1 []       = ([],  [])
separacion1 [x]      = ([x], [])
separacion1 (x:y:zs) = (x:us,y:vs)
    where (us,vs) = separacion1 zs

-- 2ª definición (por comprensión):
separacion2 :: [a] -> ([a],[a])
separacion2 xs = ([x | (x,n) <- aux, even n], 
                  [x | (x,n) <- aux, odd n])
    where aux = zip xs [0..]                                           

-- 3ª definición 
separacion3 :: [a] -> ([a],[a])
separacion3 []       = ([],[])
separacion3 (x:xs)   = (x:zs, ys)
    where (ys, zs) = separacion3 xs 

-- Comprobación de eficiencia
--    ghci> last (snd (separacion1 [1..10000000]))
--    10000000
--    (10.73 secs, 2,945,794,552 bytes)
--
--    ghci> last (snd (separacion2 [1..10000000]))
--    10000000
--    (16.33 secs, 4,351,366,976 bytes)
--    
--    λ> last (snd (separacion3 [1..10000000]))
--    10000000
--    (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]
mezcla ([],ys)     = ys 
mezcla (xs,[])     = xs 
mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es
prop_mezcla_separacion :: [Int] -> Bool
prop_mezcla_separacion xs =
    mezcla (separacion xs) == xs

-- La comprobación es
--    ghci> quickCheck prop_mezcla_separacion
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición (por recursión):

separacion1 :: [a] -> ([a],[a])

separacion1 [] = ([], [])

separacion1 [x] = ([x], [])

separacion1 (x:y:zs) = (x:us,y:vs)

where (us,vs) = separacion1 zs

-- 2ª definición (por comprensión):

separacion2 :: [a] -> ([a],[a])

separacion2 xs = ([x | (x,n) <- aux, even n],

[x | (x,n) <- aux, odd n])

where aux = zip xs [0..]

-- 3ª definición

separacion3 :: [a] -> ([a],[a])

separacion3 [] = ([],[])

separacion3 (x:xs) = (x:zs, ys)

where (ys, zs) = separacion3 xs

-- Comprobación de eficiencia

-- ghci> last (snd (separacion1 [1..10000000]))

-- 10000000

-- (10.73 secs, 2,945,794,552 bytes)

-- ghci> last (snd (separacion2 [1..10000000]))

-- 10000000

-- (16.33 secs, 4,351,366,976 bytes)

-- λ> last (snd (separacion3 [1..10000000]))

-- 10000000

-- (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]

mezcla ([],ys) = ys

mezcla (xs,[]) = xs

mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es

prop_mezcla_separacion :: [Int] -> Bool

prop_mezcla_separacion xs =

mezcla (separacion xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_mezcla_separacion

-- +++ OK, passed 100 tests.

Repeticiones según la posición

PorJosé A. Alonso 26-noviembre-20151-mayo-2016

Definir la función

   transformada :: [a] -> [a]

1	transformada :: [a] -> [a]

tal que (transformada xs) es la lista obtenida repitiendo cada elemento tantas veces como indica su posición en la lista. Por ejemplo,

   transformada [7,2,5] == [7,2,2,5,5,5]
   transformada "eco"   == "eccooo"

1 2	transformada [7,2,5] == [7,2,2,5,5,5] transformada "eco" == "eccooo"

Comprobar con QuickCheck si la transformada de una lista de n números enteros, con n ≥ 2, tiene menos de n³ elementos.

Soluciones

import Test.QuickCheck

transformada :: [a] -> [a]
transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es
prop_transformada :: [Int] -> Property
prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3
    where n = length xs

-- La comprobación es
--    ghci> quickCheck prop_transformada
--    +++ OK, passed 100 tests.

import Test.QuickCheck

transformada :: [a] -> [a]

transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es

prop_transformada :: [Int] -> Property

prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3

where n = length xs

-- La comprobación es

-- ghci> quickCheck prop_transformada

-- +++ OK, passed 100 tests.

Ternas con suma acotada

PorJosé A. Alonso 20-noviembre-20151-mayo-2016

Definir la función

   ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

1	ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

tal que (ternasAcotadas xs n) es el conjunto de ternas de números naturales de xs cuya suma es menor que n. Por ejemplo,

   ternasAcotadas [5,1,5,4,7] 12      ==  [(1,4,5),(1,5,5)]
   ternasAcotadas [5,1,5,4,7] 11      ==  [(1,4,5)]
   ternasAcotadas [5,1,5,4,7] 10      ==  []
   ternasAcotadas [1..10^6] 8         ==  [(1,2,3),(1,2,4)]
   ternasAcotadas [10^6,10^6-1..1] 8  ==  [(1,2,3),(1,2,4)]

ternasAcotadas [5,1,5,4,7] 12 == [(1,4,5),(1,5,5)]

ternasAcotadas [5,1,5,4,7] 11 == [(1,4,5)]

ternasAcotadas [5,1,5,4,7] 10 == []

ternasAcotadas [1..10^6] 8 == [(1,2,3),(1,2,4)]

ternasAcotadas [10^6,10^6-1..1] 8 == [(1,2,3),(1,2,4)]

Soluciones

import Data.List (tails, sort, nub)

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

ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas xs n =
    nub [(x,y,z) | (x,y,z) <- ternas (sort xs)
                 , x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,
--    λ> ternas [1..5]
--    [(1,2,3),(1,2,4),(1,2,5),(1,3,4),(1,3,5),(1,4,5),
--     (2,3,4),(2,3,5),(2,4,5),
--     (3,4,5)]
ternas :: [a] -> [(a,a,a)]
ternas xs = [(x,y,z) | (x:ys) <- tails xs
                     , (y:zs) <- tails ys
                     , z <- zs]

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

ternasAcotadas2 :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas2 xs n = nub (aux (sort xs))
    where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)
                            , (y:zs) <- tails (takeWhile (< (n-x)) ys)
                            , z <- takeWhile (< (n-x-y)) zs]

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

--    λ> ternasAcotadas [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (336.06 secs, 50,595,444,208 bytes)
--    λ> ternasAcotadas2 [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (0.00 secs, 0 bytes)

import Data.List (tails, sort, nub)

-- 1ª definición

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

ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

ternasAcotadas xs n =

nub [(x,y,z) | (x,y,z) <- ternas (sort xs)

, x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,

-- λ> ternas [1..5]

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

-- (2,3,4),(2,3,5),(2,4,5),

-- (3,4,5)]

ternas :: [a] -> [(a,a,a)]

ternas xs = [(x,y,z) | (x:ys) <- tails xs

, (y:zs) <- tails ys

, z <- zs]

-- 2ª definición

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

ternasAcotadas2 :: [Int] -> Int -> [(Int,Int,Int)]

ternasAcotadas2 xs n = nub (aux (sort xs))

where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)

, (y:zs) <- tails (takeWhile (< (n-x)) ys)

, z <- takeWhile (< (n-x-y)) zs]

-- Comparación de eficiencia

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

-- λ> ternasAcotadas [1..1000] 10

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

-- (336.06 secs, 50,595,444,208 bytes)

-- λ> ternasAcotadas2 [1..1000] 10

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

-- (0.00 secs, 0 bytes)

Subárboles monovalorados

PorJosé A. Alonso 19-noviembre-201525-abril-2021

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

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

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

Por ejemplo, el árbol

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

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

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

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

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

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

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir la función

   monovalorados :: Arbol -> [Arbol]

1	monovalorados :: Arbol -> [Arbol]

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

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

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

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

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

[H 5,H 6]

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

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

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

[H 9,H 9,H 9]

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

[H 9,H 7,H 9]

Soluciones

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

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

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

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

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]

monovalorados (H x) = [H x]

monovalorados (N x i d)

| todosIguales i x && todosIguales d x =

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

| otherwise = monovalorados i ++ monovalorados d

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

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

todosIguales :: Arbol -> Int -> Bool

todosIguales (H y) x = y == x

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

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

subarboles :: Arbol -> [Arbol]

subarboles (H x) = [H x]

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

Soluciones

En Maxima

Soluciones

Solución en Maxima

Soluciones

Soluciones

Soluciones

Solución con Maxima

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico