Comprensión – Página 13

Números construibles como sumas de dos dados

PorJosé A. Alonso 3-marzo-201725-marzo-2022

Un número x es construible a partir de de los números enteros positivos a y b si se puede escribir como una suma cuyos sumandos son a o b. Por ejemplo, 7 y 9 son construibles a partir de 2 y 3 ya que 7 = 2+2+3 y 9 = 3+3+3.

Definir las funciones

   construibles  :: Integer -> Integer -> [Integer]
   esConstruible :: Integer -> Integer -> Integer -> Bool

1 2	construibles :: Integer -> Integer -> [Integer] esConstruible :: Integer -> Integer -> Integer -> Bool

tales que

(construibles a b) es la lista de los números construibles a partir de a y b. Por ejemplo,

     take 5 (construibles 2 9)  ==  [2,4,6,8,9]
     take 5 (construibles 6 4)  ==  [4,6,8,10,12]
     take 5 (construibles 9 7)  ==  [7,9,14,16,18]

take 5 (construibles 2 9) == [2,4,6,8,9]

take 5 (construibles 6 4) == [4,6,8,10,12]

take 5 (construibles 9 7) == [7,9,14,16,18]

(esConstruible a b x) se verifica si x es construible a partir de a y b. Por ejemplo,

     esConstruible 2 3 7   ==  True
     esConstruible 9 7 15  ==  False

1 2	esConstruible 2 3 7 == True esConstruible 9 7 15 == False

Soluciones

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]
construibles a b = tail aux
  where aux = 0 : mezcla [a + x | x <- aux]
                         [b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla p@(x:xs) q@(y:ys) | x < y     = x : mezcla xs q
                         | x > y     = y : mezcla p  ys  
                         | otherwise = x : mezcla xs ys
mezcla []       ys                   = ys
mezcla xs       []                   = xs
              
esConstruible :: Integer -> Integer -> Integer -> Bool
esConstruible a b x = x == y
  where (y:_) = dropWhile (<x) (construibles a b)

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]

construibles a b = tail aux

where aux = 0 : mezcla [a + x | x <- aux]

[b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla p@(x:xs) q@(y:ys) | x < y = x : mezcla xs q

| x > y = y : mezcla p ys

| otherwise = x : mezcla xs ys

mezcla [] ys = ys

mezcla xs [] = xs

esConstruible :: Integer -> Integer -> Integer -> Bool

esConstruible a b x = x == y

where (y:_) = dropWhile (<x) (construibles a b)

Sucesiones alícuotas

PorJosé A. Alonso 28-febrero-20177-marzo-2017

La sucesión alícuota de un número x es la sucesión cuyo primer término es x y cada otro término es la suma de los divisores propios del término anterior. Por ejemplo, la sucesión alícuota de 10 es [10,8,7,1,0,0,0] ya que

   la suma de los divisores propios de 10 es 5 + 2 + 1 = 8
   la suma de los divisores propios de  8 es 4 + 2 + 1 = 7
   la suma de los divisores propios de  7 es 1
   la suma de los divisores propios de  1 es 0

la suma de los divisores propios de 10 es 5 + 2 + 1 = 8

la suma de los divisores propios de 8 es 4 + 2 + 1 = 7

la suma de los divisores propios de 7 es 1

la suma de los divisores propios de 1 es 0

Definir la función

   sucAlicuota :: Integer -> [Integer]

1	sucAlicuota :: Integer -> [Integer]

tal que (sucAlicuota x) es la sucesión alícuota de x. Por ejemplo,

   take 6 (sucAlicuota 10)       ==  [10,8,7,1,0,0]
   take 6 (sucAlicuota 95)       ==  [95,25,6,6,6,6]
   take 6 (sucAlicuota 220)      ==  [220,284,220,284,220,284]
   sucAlicuota 1184 !! (1+10^7)  ==  1210
   sucAlicuota 276 !! 200        ==  2790456740340877466506

take 6 (sucAlicuota 10) == [10,8,7,1,0,0]

take 6 (sucAlicuota 95) == [95,25,6,6,6,6]

take 6 (sucAlicuota 220) == [220,284,220,284,220,284]

sucAlicuota 1184 !! (1+10^7) == 1210

sucAlicuota 276 !! 200 == 2790456740340877466506

Soluciones

import Math.NumberTheory.ArithmeticFunctions (sigma)

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

sucAlicuota :: Integer -> [Integer]
sucAlicuota x = x : sucAlicuota (sumaDivisoresPropios x)

sumaDivisoresPropios :: Integer -> Integer
sumaDivisoresPropios x =
  sum [y | y <- [1..x-1], x `mod` y == 0]

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

sucAlicuota2 :: Integer -> [Integer]
sucAlicuota2 = iterate (sum . divisoresPropios)

divisoresPropios :: Integer -> [Integer]
divisoresPropios x = [y | y <- [1..x-1], x `mod` y == 0]

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

sucAlicuota3 :: Integer -> [Integer]
sucAlicuota3 x = aux x []
  where aux y ys | y `elem` ys = us ++ cycle zs
                 | otherwise   = aux (sumaDivisoresPropios y) (y:ys)
          where us = reverse ys
                zs = dropWhile (/=y) us

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

sucAlicuota4 :: Integer -> [Integer]
sucAlicuota4 x = x : sucAlicuota4 (sumaDivisoresPropios4 x)

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 x =
  sigma 1 x - x

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

--    λ> sucAlicuota 1184 !! (1+10^3)
--    1210
--    (2.02 secs, 261,081,688 bytes)
--    λ> sucAlicuota2 1184 !! (1+10^3)
--    1210
--    (2.02 secs, 245,485,568 bytes)
--    λ> sucAlicuota3 1184 !! (1+10^3)
--    1210
--    (0.02 secs, 0 bytes)
--    λ> sucAlicuota4 1184 !! (1+10^3)
--    1210
--    (0.05 secs, 0 bytes)

import Math.NumberTheory.ArithmeticFunctions (sigma)

-- 1ª definición

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

sucAlicuota :: Integer -> [Integer]

sucAlicuota x = x : sucAlicuota (sumaDivisoresPropios x)

sumaDivisoresPropios :: Integer -> Integer

sumaDivisoresPropios x =

sum [y | y <- [1..x-1], x `mod` y == 0]

-- 2ª definición

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

sucAlicuota2 :: Integer -> [Integer]

sucAlicuota2 = iterate (sum . divisoresPropios)

divisoresPropios :: Integer -> [Integer]

divisoresPropios x = [y | y <- [1..x-1], x `mod` y == 0]

-- 3ª definición

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

sucAlicuota3 :: Integer -> [Integer]

sucAlicuota3 x = aux x []

where aux y ys | y `elem` ys = us ++ cycle zs

| otherwise = aux (sumaDivisoresPropios y) (y:ys)

where us = reverse ys

zs = dropWhile (/=y) us

-- 4ª definición

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

sucAlicuota4 :: Integer -> [Integer]

sucAlicuota4 x = x : sucAlicuota4 (sumaDivisoresPropios4 x)

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 x =

sigma 1 x - x

-- Comparación de eficiencia

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

-- λ> sucAlicuota 1184 !! (1+10^3)

-- 1210

-- (2.02 secs, 261,081,688 bytes)

-- λ> sucAlicuota2 1184 !! (1+10^3)

-- 1210

-- (2.02 secs, 245,485,568 bytes)

-- λ> sucAlicuota3 1184 !! (1+10^3)

-- 1210

-- (0.02 secs, 0 bytes)

-- λ> sucAlicuota4 1184 !! (1+10^3)

-- 1210

-- (0.05 secs, 0 bytes)

Precisión de aproximaciones de pi

PorJosé A. Alonso 27-febrero-20176-marzo-2017

La precisión de una aproximación x de pi es el número de dígitos comunes entre el inicio de x y de pi. Por ejemplo, puesto que 355/113 es 3.1415929203539825 y pi es 3.141592653589793, la precisión de 355/113 es 7.

Definir las siguientes funciones

   mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
   precisionPi       :: Double -> Int
   precisionPiCR     :: CReal -> Int

mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]

precisionPi :: Double -> Int

precisionPiCR :: CReal -> Int

tales que

(mayorPrefijoComun xs ys) es el mayor prefijo común de xs e ys. Por ejemplo,

     mayorPrefijoComun []      [2,3,4,5]  ==  []
     mayorPrefijoComun [2,3,5] []         ==  []
     mayorPrefijoComun [2,3,5] [2,3,4,5]  ==  [2,3]
     mayorPrefijoComun [2,3,5] [2,5,3,4]  ==  [2]
     mayorPrefijoComun [2,3,5] [5,2,3,4]  ==  []

mayorPrefijoComun [] [2,3,4,5] == []

mayorPrefijoComun [2,3,5] [] == []

mayorPrefijoComun [2,3,5] [2,3,4,5] == [2,3]

mayorPrefijoComun [2,3,5] [2,5,3,4] == [2]

mayorPrefijoComun [2,3,5] [5,2,3,4] == []

(precisionPi x) es la precisión de la aproximación de pi x. Por ejemplo,

     precisionPi (25/8)              ==  2
     precisionPi (22/7)              ==  3
     precisionPi (sqrt 2 + sqrt 3)   ==  3
     precisionPi (377/120)           ==  4
     precisionPi (31**(1/3))         ==  4
     precisionPi (7^7/4^9)           ==  5
     precisionPi (355/113)           ==  7
     precisionPi ((2143/22)**(1/4))  ==  9

precisionPi (25/8) == 2

precisionPi (22/7) == 3

precisionPi (sqrt 2 + sqrt 3) == 3

precisionPi (377/120) == 4

precisionPi (31**(1/3)) == 4

precisionPi (7^7/4^9) == 5

precisionPi (355/113) == 7

precisionPi ((2143/22)**(1/4)) == 9

(precisionPiCR x) es la precisión de la aproximación de pi x, como números reales. Por ejemplo,

     precisionPiCR (log (640320^3+744)/(sqrt 163))                        == 31
     precisionPiCR (log (5280^3*(236674+30303*sqrt 61)^3+744)/(sqrt 427)) == 53

1 2	precisionPiCR (log (640320^3+744)/(sqrt 163)) == 31 precisionPiCR (log (5280^3(236674+30303sqrt 61)^3+744)/(sqrt 427)) == 53

Nota: Para la definición precisionPiCR se usa la librería Data.Number.CReal que se instala con

   cabal install numbers

1	cabal install numbers

Soluciones

import Data.Number.CReal

-- mayorPrefijoComún
-- =================

-- 1ª definición
mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun [] _ = []
mayorPrefijoComun _ [] = []
mayorPrefijoComun (x:xs) (y:ys)
  | x == y    = x : mayorPrefijoComun xs ys
  | otherwise = []

-- 2ª definición
mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun2 xs ys =
  [x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)] 

-- 3ª definición
mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun3 xs ys =
  [x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)] 

-- 4ª definición
mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun4 xs =
  map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición
mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun5 =
  ((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi
-- ===========

-- 1ª definición
precisionPi :: Double -> Int
precisionPi x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = show x
        ys = show pi

-- 2ª definición
precisionPi2 :: Double -> Int
precisionPi2 =
  pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR
-- =============

precisionPiCR :: CReal -> Int
precisionPiCR = aux 50
  where aux n x | p < n-1   = p
                | otherwise = aux (n+50) x
          where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por
-- ejemplo,
--    precisionPiCRHasta 1 3.14   ==  2
--    precisionPiCRHasta 5 3.14   ==  3
--    precisionPiCRHasta 5 3.142  ==  3
--    precisionPiCRHasta 5 3.141  ==  4
precisionPiCRHasta :: Int -> CReal -> Int
precisionPiCRHasta n x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = showCReal n x
        ys = showCReal n pi

import Data.Number.CReal

-- mayorPrefijoComún

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

-- 1ª definición

mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun [] _ = []

mayorPrefijoComun _ [] = []

mayorPrefijoComun (x:xs) (y:ys)

| x == y = x : mayorPrefijoComun xs ys

| otherwise = []

-- 2ª definición

mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun2 xs ys =

[x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)]

-- 3ª definición

mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun3 xs ys =

[x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)]

-- 4ª definición

mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun4 xs =

map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición

mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]

mayorPrefijoComun5 =

((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi

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

-- 1ª definición

precisionPi :: Double -> Int

precisionPi x =

length (mayorPrefijoComun xs ys) - 1

where xs = show x

ys = show pi

-- 2ª definición

precisionPi2 :: Double -> Int

precisionPi2 =

pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR

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

precisionPiCR :: CReal -> Int

precisionPiCR = aux 50

where aux n x | p < n-1 = p

| otherwise = aux (n+50) x

where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por

-- ejemplo,

-- precisionPiCRHasta 1 3.14 == 2

-- precisionPiCRHasta 5 3.14 == 3

-- precisionPiCRHasta 5 3.142 == 3

-- precisionPiCRHasta 5 3.141 == 4

precisionPiCRHasta :: Int -> CReal -> Int

precisionPiCRHasta n x =

length (mayorPrefijoComun xs ys) - 1

where xs = showCReal n x

ys = showCReal n pi

Cálculo de pi mediante el método de Newton

PorJosé A. Alonso 24-febrero-201725-abril-2021

El método de Newton para el cálculo de pi se basa en la relación

y en el desarrollo del arco seno

de donde se obtiene la fórmula

La primeras aproximaciones son

   a(0) = 6*(1/2)                               = 3.0
   a(1) = 6*(1/2+1/(2*3*2^3))                   = 3.125
   a(2) = 6*(1/2+1/(2*3*2^3)+(1*3)/(2*4*5*2^5)) = 3.1390625

a(0) = 6*(1/2) = 3.0

a(1) = 6*(1/2+1/(2*3*2^3)) = 3.125

a(2) = 6*(1/2+1/(2*3*2^3)+(1*3)/(2*4*5*2^5)) = 3.1390625

Definir las funciones

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

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Newton. Por ejemplo,

     aproximacionPi 0   ==  3.0
     aproximacionPi 1   ==  3.125
     aproximacionPi 2   ==  3.1390625
     aproximacionPi 10  ==  3.1415926468755613
     aproximacionPi 21  ==  3.141592653589793
     pi                 ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.125

aproximacionPi 2 == 3.1390625

aproximacionPi 10 == 3.1415926468755613

aproximacionPi 21 == 3.141592653589793

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi donde k toma los valores de la lista xs. Por ejemplo, (grafica [1..30]) dibuja

Nota: Este ejercicio ha sido propuesto por Manuel Herrera.

Soluciones

import Graphics.Gnuplot.Simple

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

aproximacionPi :: Int -> Double
aproximacionPi n = 6 * arcsinX
  where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]
factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]
potenciasK k = (0.5**k)/k : potenciasK (k+2)

fraccionesPI :: [Double]
fraccionesPI =
  scanl (*) (1/2) (tail (zipWith (/) [1,3..] [2,4..]))

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]
serie = scanl1 (+) (zipWith (/)
                            (map fromIntegral numeradores)
                            (map fromIntegral denominadores))
  where numeradores    = 1 : scanl1 (*) [1,3..]
        denominadores  = zipWith (*) denominadores1 denominadores2
        denominadores1 = 2 : scanl1 (*) [2,4..]
        denominadores2 = 1 : [n * 2^n | n <- [3,5..]]

grafica :: [Int] -> IO ()
grafica xs = 
    plotList [Key Nothing]
             [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple

-- 1ª definición

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

aproximacionPi :: Int -> Double

aproximacionPi n = 6 * arcsinX

where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]

factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]

potenciasK k = (0.5**k)/k : potenciasK (k+2)

fraccionesPI :: [Double]

fraccionesPI =

scanl (*) (1/2) (tail (zipWith (/) [1,3..] [2,4..]))

-- 2ª definición

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]

serie = scanl1 (+) (zipWith (/)

(map fromIntegral numeradores)

(map fromIntegral denominadores))

where numeradores = 1 : scanl1 (*) [1,3..]

denominadores = zipWith (*) denominadores1 denominadores2

denominadores1 = 2 : scanl1 (*) [2,4..]

denominadores2 = 1 : [n * 2^n | n <- [3,5..]]

grafica :: [Int] -> IO ()

grafica xs =

plotList [Key Nothing]

[(k,aproximacionPi k) | k <- xs]

Cálculo de pi mediante la variante de Euler de la serie armónica

PorJosé A. Alonso 21-febrero-201726-marzo-2022

En el artículo El desarrollo más bello de Pi como suma infinita, Miguel Ángel Morales comenta el desarrollo de pi publicado por Leonhard Euler en su libro «Introductio in Analysis Infinitorum» (1748).

El desarrollo es el siguiente

y se obtiene a partir de la serie armónica

modificando sólo el signo de algunos términos según el siguiente criterio:

Dejamos un + cuando el denominador de la fracción sea un 2 o un primo de la forma 4m-1.
Cambiamos a – si el denominador de la fracción es un primo de la forma 4m+1.
Si el número es compuesto ponemos el signo que quede al multiplicar los signos correspondientes a cada factor.

Por ejemplo,

la de denominador 3 = 4×1-1 lleva un +,
la de denominador 5 = 4×1+1 lleva un -,
la de denominador 13 = 4×3+1 lleva un -,
la de denominador 6 = 2×3 lleva un + (porque los dos llevan un +),
la de denominador 10 = 2×5 lleva un – (porque el 2 lleva un + y el 5 lleva un -) y
la de denominador 50 = 5x5x2 lleva un + (un – por el primer 5, otro – por el segundo 5 y un + por el 2).

Definir las funciones

  aproximacionPi :: Int -> Double
  grafica        :: Int -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: Int -> IO ()

tales que

(aproximacionPi n) es la aproximación de pi obtenida sumando los n primeros términos de la serie de Euler. Por ejemplo.

     aproximacionPi 1        ==  1.0
     aproximacionPi 10       ==  2.3289682539682537
     aproximacionPi 100      ==  2.934318000847734
     aproximacionPi 1000     ==  3.0603246224585128
     aproximacionPi 10000    ==  3.1105295744825403
     aproximacionPi 100000   ==  3.134308801935256
     aproximacionPi 1000000  ==  3.1395057903490806

aproximacionPi 1 == 1.0

aproximacionPi 10 == 2.3289682539682537

aproximacionPi 100 == 2.934318000847734

aproximacionPi 1000 == 3.0603246224585128

aproximacionPi 10000 == 3.1105295744825403

aproximacionPi 100000 == 3.134308801935256

aproximacionPi 1000000 == 3.1395057903490806

(grafica n) dibuja la gráfica de las aproximaciones de pi usando k sumando donde k toma los valores de la lista [100,110..n]. Por ejemplo, al evaluar (grafica 4000) se obtiene

Nota: Este ejercicio ha sido propuesto por Paula Macías.

Soluciones

import Data.Numbers.Primes
import Graphics.Gnuplot.Simple

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

aproximacionPi :: Int -> Double
aproximacionPi n =
  sum [1 / fromIntegral (k * signo k) | k <- [1..n]] 

signoPrimo :: Int -> Int
signoPrimo 2 = 1
signoPrimo p | p `mod` 4 == 3 = 1
             | otherwise      = -1

signo :: Int -> Int
signo n | isPrime n = signoPrimo n
        | otherwise = product (map signoPrimo (primeFactors n))

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n = serieEuler !! (n-1)

serieEuler :: [Double]
serieEuler =
  scanl1 (+) [1 / fromIntegral (n * signo n) | n <- [1..]]

-- Definición de grafica
-- =====================

grafica :: Int -> IO ()
grafica n = 
    plotList [Key Nothing]
             [(k,aproximacionPi2 k) | k <- [100,110..n]]

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

-- 1ª definición

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

aproximacionPi :: Int -> Double

aproximacionPi n =

sum [1 / fromIntegral (k * signo k) | k <- [1..n]]

signoPrimo :: Int -> Int

signoPrimo 2 = 1

signoPrimo p | p `mod` 4 == 3 = 1

| otherwise = -1

signo :: Int -> Int

signo n | isPrime n = signoPrimo n

| otherwise = product (map signoPrimo (primeFactors n))

-- 2ª definición

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = serieEuler !! (n-1)

serieEuler :: [Double]

serieEuler =

scanl1 (+) [1 / fromIntegral (n * signo n) | n <- [1..]]

-- Definición de grafica

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

grafica :: Int -> IO ()

grafica n =

plotList [Key Nothing]

[(k,aproximacionPi2 k) | k <- [100,110..n]]

Sucesión de trazas de dígitos de pi

PorJosé A. Alonso 17-febrero-201724-febrero-2017

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Las matrices de orden 1×1, 2×2, …, 5×5 formadas por los primeros dígitos de pi son

   ( 3 )  ( 3 1 )  ( 3 1 4 )  ( 3 1 4 1 )  ( 3 1 4 1 5 )
          ( 4 1 )  ( 1 5 9 )  ( 5 9 2 6 )  ( 9 2 6 5 3 )
                   ( 2 6 5 )  ( 5 3 5 8 )  ( 5 8 9 7 9 )
                              ( 9 7 9 3 )  ( 3 2 3 8 4 )
                                           ( 6 2 6 4 3 )

( 3 ) ( 3 1 ) ( 3 1 4 ) ( 3 1 4 1 ) ( 3 1 4 1 5 )

( 4 1 ) ( 1 5 9 ) ( 5 9 2 6 ) ( 9 2 6 5 3 )

( 2 6 5 ) ( 5 3 5 8 ) ( 5 8 9 7 9 )

( 9 7 9 3 ) ( 3 2 3 8 4 )

( 6 2 6 4 3 )

y sus trazas (es decir, sumas de los elementos de la diagonal principal) son 3, 4, 13, 20 y 25, respectivamente.

Definir la función

   trazas :: Int -> IO [Int]

1	trazas :: Int -> IO [Int]

tal que (trazas n) es la lista de las trazas de las matrices de orden 1×1, 2×2, 3×3, …, nxn formadas por los primeros dígitos de pi. Por ejemplo,

   λ> trazas 20
   [3,4,13,20,25,30,19,32,41,59,62,64,58,75,62,60,80,99,78,108]
   λ> ts <- trazas 1000
   λ> maximum ts
   4644
   λ> maximum <$> trazas 1000
   4644

λ> trazas 20

[3,4,13,20,25,30,19,32,41,59,62,64,58,75,62,60,80,99,78,108]

λ> ts <- trazas 1000

λ> maximum ts

4644

λ> maximum <$> trazas 1000

4644

Soluciones

import Data.Char (digitToInt)
import Data.Matrix (fromList, trace)

trazas :: Int -> IO [Int]
trazas n = do
  (d:_:ds) <- readFile "Digitos_de_pi.txt"
  let xs = map digitToInt (d:ds)
  return [trace (fromList k k xs) | k <- [1..n]]

import Data.Char (digitToInt)

import Data.Matrix (fromList, trace)

trazas :: Int -> IO [Int]

trazas n = do

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

let xs = map digitToInt (d:ds)

return [trace (fromList k k xs) | k <- [1..n]]

Distribución de dígitos de pi

PorJosé A. Alonso 16-febrero-201725-abril-2021

Se pueden generar los dígitos de Pi, como se explica en el artículo Unbounded spigot algorithms for the digits of pi, con la función digitosPi definida por

   digitosPi :: [Integer]
   digitosPi = g(1,0,1,1,3,3) where
     g (q,r,t,k,n,l) = 
       if 4*q+r-t < n*t
       then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
       else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

Por ejemplo,

   λ> take 25 digitosPi
   [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

1 2	λ> take 25 digitosPi [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

La distribución de los primeros 25 dígitos de pi es [0,2,3,5,3,3,3,1,2,3] ya que el 0 no aparece, el 1 ocurre 2 veces, el 3 ocurre 3 veces, el 4 ocurre 5 veces, …

Usando digitosPi, definir las siguientes funciones

   distribucionDigitosPi :: Int -> [Int]
   frecuenciaDigitosPi   :: Int -> [Double]

1 2	distribucionDigitosPi :: Int -> [Int] frecuenciaDigitosPi :: Int -> [Double]

tales que

(distribucionDigitosPi n) es la distribución de los n primeros dígitos de pi. Por ejemplo,

     λ> distribucionDigitosPi 10
     [0,2,1,2,1,2,1,0,0,1]
     λ> distribucionDigitosPi 100
     [8,8,12,12,10,8,9,8,12,13]
     λ> distribucionDigitosPi 1000
     [93,116,103,103,93,97,94,95,101,105]
     λ> distribucionDigitosPi 5000
     [466,531,496,460,508,525,513,488,492,521]

λ> distribucionDigitosPi 10

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

λ> distribucionDigitosPi 100

[8,8,12,12,10,8,9,8,12,13]

λ> distribucionDigitosPi 1000

[93,116,103,103,93,97,94,95,101,105]

λ> distribucionDigitosPi 5000

[466,531,496,460,508,525,513,488,492,521]

(frecuenciaDigitosPi n) es la frecuencia de los n primeros dígitos de pi. Por ejemplo,

   λ> frecuenciaDigitosPi 10
   [0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]
   λ> frecuenciaDigitosPi 100
   [8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]
   λ> frecuenciaDigitosPi 1000
   [9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]
   λ> frecuenciaDigitosPi 5000
   [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

λ> frecuenciaDigitosPi 10

[0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]

λ> frecuenciaDigitosPi 100

[8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]

λ> frecuenciaDigitosPi 1000

[9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]

λ> frecuenciaDigitosPi 5000

[9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

Soluciones

import Data.Array
import Data.List (group, sort)

digitosPi :: [Integer]
digitosPi = g(1,0,1,1,3,3) where
  g (q,r,t,k,n,l) = 
    if 4*q+r-t < n*t
    then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
    else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

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

distribucionDigitosPi :: Int -> [Int]
distribucionDigitosPi n =
    elems (accumArray (+) 0 (0,9) [(i,1)
                                  | i <- take n digitosPi]) 

frecuenciaDigitosPi :: Int -> [Double]
frecuenciaDigitosPi n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]
  where m = fromIntegral n

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

distribucionDigitosPi2 :: Int -> [Int]
distribucionDigitosPi2 n =
  [length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]
frecuenciaDigitosPi2 n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]
  where m = fromIntegral n

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

--    λ> last (take 5000 digitosPi)
--    2
--    (4.47 secs, 3,927,848,448 bytes)
--    λ> frecuenciaDigitosPi 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.01 secs, 0 bytes)
--    λ> frecuenciaDigitosPi2 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.02 secs, 0 bytes)

import Data.Array

import Data.List (group, sort)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

-- 1ª definición

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

distribucionDigitosPi :: Int -> [Int]

distribucionDigitosPi n =

elems (accumArray (+) 0 (0,9) [(i,1)

| i <- take n digitosPi])

frecuenciaDigitosPi :: Int -> [Double]

frecuenciaDigitosPi n =

[100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]

where m = fromIntegral n

-- 2ª definición

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

distribucionDigitosPi2 :: Int -> [Int]

distribucionDigitosPi2 n =

[length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]

frecuenciaDigitosPi2 n =

[100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]

where m = fromIntegral n

-- Comparación de eficiencia

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

-- λ> last (take 5000 digitosPi)

-- 2

-- (4.47 secs, 3,927,848,448 bytes)

-- λ> frecuenciaDigitosPi 5000

-- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

-- (0.01 secs, 0 bytes)

-- λ> frecuenciaDigitosPi2 5000

-- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

-- (0.02 secs, 0 bytes)

Cálculo de pi usando la fórmula de Vieta

PorJosé A. Alonso 14-febrero-201725-abril-2021

La fórmula de Vieta para el cálculo de pi es la siguiente

Definir las funciones

   aproximacionPi :: Int -> Double
   errorPi :: Double -> Int

1 2	aproximacionPi :: Int -> Double errorPi :: Double -> Int

tales que

(aproximacionPi n) es la aproximación de pi usando n factores de la fórmula de Vieta. Por ejemplo,

     aproximacionPi  5  ==  3.140331156954753
     aproximacionPi 10  ==  3.1415914215112
     aproximacionPi 15  ==  3.141592652386592
     aproximacionPi 20  ==  3.1415926535886207
     aproximacionPi 25  ==  3.141592653589795

aproximacionPi 5 == 3.140331156954753

aproximacionPi 10 == 3.1415914215112

aproximacionPi 15 == 3.141592652386592

aproximacionPi 20 == 3.1415926535886207

aproximacionPi 25 == 3.141592653589795

(errorPi x) es el menor número de factores de la fórmula de Vieta necesarios para obtener pi con un error menor que x. Por ejemplo,

     errorPi 0.1        ==  2
     errorPi 0.01       ==  4
     errorPi 0.001      ==  6
     errorPi 0.0001     ==  7
     errorPi 1e-4       ==  7
     errorPi 1e-14      ==  24
     pi                 ==  3.141592653589793
     aproximacionPi 24  ==  3.1415926535897913

errorPi 0.1 == 2

errorPi 0.01 == 4

errorPi 0.001 == 6

errorPi 0.0001 == 7

errorPi 1e-4 == 7

errorPi 1e-14 == 24

pi == 3.141592653589793

aproximacionPi 24 == 3.1415926535897913

Soluciones

-- 1ª definición de aproximacionPi
aproximacionPi :: Int -> Double
aproximacionPi n = product [2 / aux x | x <- [0..n]]
  where
    aux 0 = 1
    aux 1 = sqrt 2
    aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n = product [2/x | x <- 1 : xs] 
  where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi
aproximacionPi3 :: Int -> Double
aproximacionPi3 n =  product (2 : take n (map (2/) xs))
  where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi
errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x = until aceptable (+1) 1
  where aceptable n = abs (pi - aproximacionPi n) < x

-- 1ª definición de aproximacionPi

aproximacionPi :: Int -> Double

aproximacionPi n = product [2 / aux x | x <- [0..n]]

where

aux 0 = 1

aux 1 = sqrt 2

aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = product [2/x | x <- 1 : xs]

where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi

aproximacionPi3 :: Int -> Double

aproximacionPi3 n = product (2 : take n (map (2/) xs))

where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi

errorPi :: Double -> Int

errorPi x = head [n | n <- [1..]

, abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi

errorPi2 :: Double -> Int

errorPi2 x = until aceptable (+1) 1

where aceptable n = abs (pi - aproximacionPi n) < x

Cálculo de pi usando el producto de Wallis

PorJosé A. Alonso 13-febrero-201720-febrero-2017

El producto de Wallis es una expresión, descubierta por John Wallis en 1655, para representar el valor de π y que establece que:

    π     2     2     4     4     6     6     8     8
   --- = --- · --- · --- · --- · --- · --- · --- · --- ···
    2     1     3     3     5     5     7     7     9

π 2 2 4 4 6 6 8 8

--- = --- · --- · --- · --- · --- · --- · --- · --- ···

2 1 3 3 5 5 7 7 9

Definir las funciones

   factoresWallis  :: [Rational]
   productosWallis :: [Rational]
   aproximacionPi  :: Int -> Double
   errorPi         :: Double -> Int

factoresWallis :: [Rational]

productosWallis :: [Rational]

aproximacionPi :: Int -> Double

errorPi :: Double -> Int

tales que

factoresWallis es la sucesión de los factores del productos de Wallis. Por ejemplo,

     λ> take 10 factoresWallis
     [2 % 1,2 % 3,4 % 3,4 % 5,6 % 5,6 % 7,8 % 7,8 % 9,10 % 9,10 % 11]

1 2	λ> take 10 factoresWallis [2 % 1,2 % 3,4 % 3,4 % 5,6 % 5,6 % 7,8 % 7,8 % 9,10 % 9,10 % 11]

productosWallis es la sucesión de los productos de los primeros factores de Wallis. Por ejemplo,

     λ> take 7 productosWallis
     [2 % 1,4 % 3,16 % 9,64 % 45,128 % 75,256 % 175,2048 % 1225]

1 2	λ> take 7 productosWallis [2 % 1,4 % 3,16 % 9,64 % 45,128 % 75,256 % 175,2048 % 1225]

(aproximacionPi n) es la aproximación de pi obtenida multiplicando los n primeros factores de Wallis. Por ejemplo,

     aproximacionPi 20     ==  3.2137849402931895
     aproximacionPi 200    ==  3.1493784731686008
     aproximacionPi 2000   ==  3.142377365093878
     aproximacionPi 20000  ==  3.141671186534396

aproximacionPi 20 == 3.2137849402931895

aproximacionPi 200 == 3.1493784731686008

aproximacionPi 2000 == 3.142377365093878

aproximacionPi 20000 == 3.141671186534396

(errorPi x) es el menor número de factores de Wallis necesarios para obtener pi con un error menor que x. Por ejemplo,

     errorPi 0.1     ==  14
     errorPi 0.01    ==  155
     errorPi 0.001   ==  1569
     errorPi 0.0001  ==  15707

errorPi 0.1 == 14

errorPi 0.01 == 155

errorPi 0.001 == 1569

errorPi 0.0001 == 15707

Soluciones

import Data.Ratio

factoresWallis :: [Rational]
factoresWallis =
  concat [[y%(y-1),  y%(y+1)] | x <- [1..], let y = 2*x]

productosWallis :: [Rational]
productosWallis = scanl1 (*) factoresWallis

aproximacionPi :: Int -> Double
aproximacionPi n =
  fromRational (2 * productosWallis !! n)

errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x =
  length (takeWhile (>=x) [abs (pi - 2 * fromRational y)
                          | y <- productosWallis])

-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n =
  2 * productosWallis2 !! n

productosWallis2 :: [Double]
productosWallis2 = scanl1 (*) factoresWallis2

factoresWallis2 :: [Double]
factoresWallis2 =
  concat [[y/(y-1),  y/(y+1)] | x <- [1..], let y = 2*x]

-- 3ª definición de errorPi
errorPi3 :: Double -> Int
errorPi3 x = head [n | n <- [1..]
                     , abs (pi - aproximacionPi2 n) < x]

-- Comparación de eficiencia
--    λ> errorPi 0.001
--    1569
--    (0.82 secs, 374,495,816 bytes)
--
--    λ> errorPi2 0.001
--    1569
--    (0.79 secs, 369,282,320 bytes)
--
--    λ> errorPi3 0.001
--    1569
--    (0.04 secs, 0 bytes)

import Data.Ratio

factoresWallis :: [Rational]

factoresWallis =

concat [[y%(y-1), y%(y+1)] | x <- [1..], let y = 2*x]

productosWallis :: [Rational]

productosWallis = scanl1 (*) factoresWallis

aproximacionPi :: Int -> Double

aproximacionPi n =

fromRational (2 * productosWallis !! n)

errorPi :: Double -> Int

errorPi x = head [n | n <- [1..]

, abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi

errorPi2 :: Double -> Int

errorPi2 x =

length (takeWhile (>=x) [abs (pi - 2 * fromRational y)

| y <- productosWallis])

-- 2ª definición de aproximacionPi

aproximacionPi2 :: Int -> Double

aproximacionPi2 n =

2 * productosWallis2 !! n

productosWallis2 :: [Double]

productosWallis2 = scanl1 (*) factoresWallis2

factoresWallis2 :: [Double]

factoresWallis2 =

concat [[y/(y-1), y/(y+1)] | x <- [1..], let y = 2*x]

-- 3ª definición de errorPi

errorPi3 :: Double -> Int

errorPi3 x = head [n | n <- [1..]

, abs (pi - aproximacionPi2 n) < x]

-- Comparación de eficiencia

-- λ> errorPi 0.001

-- 1569

-- (0.82 secs, 374,495,816 bytes)

-- λ> errorPi2 0.001

-- 1569

-- (0.79 secs, 369,282,320 bytes)

-- λ> errorPi3 0.001

-- 1569

-- (0.04 secs, 0 bytes)

Caminos en un árbol binario con suma dada

PorJosé A. Alonso 10-febrero-201717-febrero-2017

Los árboles binarios se pueden representar con el de tipo de dato algebraico

   data Arbol = H
              | N Int Arbol Arbol
     deriving Show

data Arbol = H

| N Int Arbol Arbol

deriving Show

Por ejemplo, los árboles

       3                7                 1
      / \              / \               /  \
     2   4            5   8             /    \
    / \   \          /   / \           /      \
   1   7   5        6   4   9         3       -1
                                     / \     /  \
                                    2   1   4    5                        
                                       /   / \    \                    
                                      1   1   2    6

3 7 1

/ \ / \ / \

2 4 5 8 / \

/ \ \ / / \ / \

1 7 5 6 4 9 3 -1

/ \ / \

2 1 4 5

/ / \ \

1 1 2 6

se representan por

   ej1, ej2, ej3 :: Arbol
   ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))
   ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))
   ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))
             (N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))

ej1, ej2, ej3 :: Arbol

ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))

ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))

(N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))

Definir las funciones

   caminos     :: Arbol -> [[Int]]
   caminosSuma :: Arbol -> Int -> [[Int]]

1 2	caminos :: Arbol -> [[Int]] caminosSuma :: Arbol -> Int -> [[Int]]

tales que

(caminos a) es la lista de los caminos entre dos nodos cualesquiera del árbol a. Por ejemplo,

     λ> caminos ej1
     [[3],[3,2],[3,2,1],[3,2,7],[3,4],[3,4,5],
      [2],[2,1],[2,7],[1],[7],[4],[4,5],[5]]
     λ> caminos ej2
     [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9],
      [5],[5,6],[6],[8],[8,4],[8,9],[4],[9]]
     λ> length (caminos ej3)
     33

λ> caminos ej1

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

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

λ> caminos ej2

[[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9],

[5],[5,6],[6],[8],[8,4],[8,9],[4],[9]]

λ> length (caminos ej3)

(caminosSuma a k) es la lista de los caminos entre dos nodos cualesquiera del árbol a cuya suma es k. Por ejemplo,

     λ> caminosSuma ej1 3
     [[3],[2,1]]
     λ> caminosSuma ej3 3
     [[3],[-1,4]]
     λ> caminosSuma ej3 4
     [[1,3],[1,-1,4],[3,1],[-1,4,1],[-1,5],[4]]
     λ> caminosSuma ej3 5
     [[1,3,1],[1,-1,4,1],[1,-1,5],[3,2],[3,1,1],[-1,4,2],[4,1],[5]]
     λ> caminosSuma ej3 6
     [[1,3,2],[1,3,1,1],[1,-1,4,2],[4,2],[6]]
     λ> caminosSuma ej3 7
     []

λ> caminosSuma ej1 3

[[3],[2,1]]

λ> caminosSuma ej3 3

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

λ> caminosSuma ej3 4

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

λ> caminosSuma ej3 5

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

λ> caminosSuma ej3 6

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

λ> caminosSuma ej3 7

[]

Soluciones

data Arbol = H
           | N Int Arbol Arbol
  deriving Show

ej1, ej2, ej3 :: Arbol
ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))
ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))
          (N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))
  
caminos :: Arbol -> [[Int]]
caminos H           = []
caminos a@(N r i d) = caminosDesdeRaiz a ++ caminos i ++ caminos d

-- (caminosDesdeRaiz a) es la lista de las caminosDesdeRaiz desde la
-- raíz de a hasta cualquiera de sus nodos. Por ejemplo.
--    λ> caminosDesdeRaiz ej1
--    [[3],[3,2],[3,2,1],[3,2,7],[3,4],[3,4,5]]
--    λ> caminosDesdeRaiz ej2
--    [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9]]
caminosDesdeRaiz :: Arbol -> [[Int]]
caminosDesdeRaiz H = []
caminosDesdeRaiz (N x i d) =
  [x] : [x:ys | ys <- caminosDesdeRaiz i ++ caminosDesdeRaiz d]

caminosSuma :: Arbol -> Int -> [[Int]]
caminosSuma a k =
  [ys | ys <- caminos a
      , sum ys == k]

data Arbol = H

| N Int Arbol Arbol

deriving Show

ej1, ej2, ej3 :: Arbol

ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))

ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))

(N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))

caminos :: Arbol -> [[Int]]

caminos H = []

caminos a@(N r i d) = caminosDesdeRaiz a ++ caminos i ++ caminos d

-- (caminosDesdeRaiz a) es la lista de las caminosDesdeRaiz desde la

-- raíz de a hasta cualquiera de sus nodos. Por ejemplo.

-- λ> caminosDesdeRaiz ej1

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

-- λ> caminosDesdeRaiz ej2

-- [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9]]

caminosDesdeRaiz :: Arbol -> [[Int]]

caminosDesdeRaiz H = []

caminosDesdeRaiz (N x i d) =

[x] : [x:ys | ys <- caminosDesdeRaiz i ++ caminosDesdeRaiz d]

caminosSuma :: Arbol -> Int -> [[Int]]

caminosSuma a k =

[ys | ys <- caminos a

, sum ys == k]

Referencia

Basado en Print all k-sum paths in a binary tree de GeeksforGeeks.

Aplicaciones de operaciones

PorJosé A. Alonso 6-febrero-201713-febrero-2017

Definir la función

   aplicaciones :: [a -> b -> c] -> [a] -> [b] -> [c]

1	aplicaciones :: [a -> b -> c] -> [a] -> [b] -> [c]

tal que (aplicaciones os xs ys) es la lista obtenida aplicando las operaciones de os a los elementos de xs es ys. Por ejemplo,

   λ> aplicaciones [(+),(*)] [1,2] [5,8]
   [6,9,7,10,5,8,10,16]
   λ> aplicaciones [(+),(*)] [1,2] [5]
   [6,7,5,10]
   λ> aplicaciones [(<),(>)] ["ab","c"] ["def","c"]
   [True,True,True,False,False,False,False,False]
   λ> import Data.List
   λ> aplicaciones [(++),intersect] ["ab","c"] ["bd","cf"]
   ["abbd","abcf","cbd","ccf","b","","","c"]

λ> aplicaciones [(+),(*)] [1,2] [5,8]

[6,9,7,10,5,8,10,16]

λ> aplicaciones [(+),(*)] [1,2] [5]

[6,7,5,10]

λ> aplicaciones [(<),(>)] ["ab","c"] ["def","c"]

[True,True,True,False,False,False,False,False]

λ> import Data.List

λ> aplicaciones [(++),intersect] ["ab","c"] ["bd","cf"]

["abbd","abcf","cbd","ccf","b","","","c"]

Soluciones

-- 1ª definición
aplicaciones :: [a -> b -> c] -> [a] -> [b] -> [c]
aplicaciones os xs ys =
  [os x y | os <- os, x <- xs, y <- ys]

-- 2ª definición
aplicaciones2 :: [a -> b -> c] -> [a] -> [b] -> [c]
aplicaciones2 os xs ys = os <*> xs <*> ys

-- 3ª definición
aplicaciones3 :: [a -> b -> c] -> [a] -> [b] -> [c]
aplicaciones3 = ((<*>) .) . (<*>)

-- 1ª definición

aplicaciones :: [a -> b -> c] -> [a] -> [b] -> [c]

aplicaciones os xs ys =

[os x y | os <- os, x <- xs, y <- ys]

-- 2ª definición

aplicaciones2 :: [a -> b -> c] -> [a] -> [b] -> [c]

aplicaciones2 os xs ys = os <*> xs <*> ys

-- 3ª definición

aplicaciones3 :: [a -> b -> c] -> [a] -> [b] -> [c]

aplicaciones3 = ((<*>) .) . (<*>)

Particiones de una lista

PorJosé A. Alonso 2-febrero-20179-febrero-2017

Definir la función

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

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

tal que (particiones xs) es la lista de las particiones de xs en segmentos de elementos consecutivos. Por ejemplo,

   λ> particiones [1..3]
   [[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[1,2,3]]]
   λ> mapM_ print (particiones "abcd")
   ["a","b","c","d"]
   ["a","b","cd"]
   ["a","bc","d"]
   ["a","bcd"]
   ["ab","c","d"]
   ["ab","cd"]
   ["abc","d"]
   ["abcd"]
   λ> length (particiones [1..22])
   2097152

λ> particiones [1..3]

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

λ> mapM_ print (particiones "abcd")

["a","b","c","d"]

["a","b","cd"]

["a","bc","d"]

["a","bcd"]

["ab","c","d"]

["ab","cd"]

["abc","d"]

["abcd"]

λ> length (particiones [1..22])

2097152

Comprobar con QuickCheck que la concatenación de cada uno de los elementos de (particiones xs) es igual a xs.

Nota: En la comprobación usar ejemplos pequeños como se indica a continuación

   quickCheckWith (stdArgs {maxSize=10}) prop_particiones

1	quickCheckWith (stdArgs {maxSize=10}) prop_particiones

Soluciones

import Test.QuickCheck

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones xs =
  [(take k xs) : yss | k <- [1..n], yss <- particiones (drop k xs)]
  where n = length xs

-- La propiedad es
prop_particiones :: [Int] -> Bool
prop_particiones xs =
  all (\yss -> concat yss == xs) (particiones xs)

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

import Test.QuickCheck

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

particiones [] = [[]]

particiones xs =

[(take k xs) : yss | k <- [1..n], yss <- particiones (drop k xs)]

where n = length xs

-- La propiedad es

prop_particiones :: [Int] -> Bool

prop_particiones xs =

all (\yss -> concat yss == xs) (particiones xs)

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Máximo producto de pares en la lista

PorJosé A. Alonso 30-enero-201726-marzo-2022

Definir la función

  maximoProducto :: [Int] -> Maybe Int

1	maximoProducto :: [Int] -> Maybe Int

tal que (maximoProducto xs) es el mayor elemento de xs que se puede escribir
como producto de dos elementos distintos de xs o Nothing, en el caso de que
ningún elemento de xs se pueda escribir como producto de dos elementos
distintos de xs, donde xs es una lista de números mayores que 0. Por ejemplo,

   maximoProducto [10, 3, 5, 30, 35]       ==  Just 30
   maximoProducto [10, 2, 2, 4, 30, 35]    ==  Just 4
   maximoProducto [17, 2, 1, 35, 30]       ==  Just 35
   maximoProducto [2,4]                    ==  Nothing
   maximoProducto [2, 5, 7, 8]             ==  Nothing
   maximoProducto [10, 2, 4, 30, 35]       ==  Nothing
   maximoProducto [1+2^n | n <- [1..10^6]] ==  Just 4611686018427387905

maximoProducto [10, 3, 5, 30, 35] == Just 30

maximoProducto [10, 2, 2, 4, 30, 35] == Just 4

maximoProducto [17, 2, 1, 35, 30] == Just 35

maximoProducto [2,4] == Nothing

maximoProducto [2, 5, 7, 8] == Nothing

maximoProducto [10, 2, 4, 30, 35] == Nothing

maximoProducto [1+2^n | n <- [1..10^6]] == Just 4611686018427387905

En el primer ejemplo, 30 es el producto de 10 y 3; en el segundo, 4 es el producto de 2 y 2 y en el tercero, 35 es el producto de 1 y 35.

Soluciones

import Data.List (delete, nub, sort)

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

maximoProducto1 :: [Int] -> Maybe Int
maximoProducto1 xs
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where
    ys = reverse (sort xs)
    zs = [y | y <- ys, y `elem` productos xs]

-- (productos xs) es la lista de los números que son productos de dos
-- elementos de xs. Por ejemplo, 
--   productos [4,3,5,2]  ==  [12,20,8,15,6,10]
productos :: [Int] -> [Int]
productos xs =
  nub [y * z | y <- xs, z <- delete y xs]

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

maximoProducto2 :: [Int] -> Maybe Int
maximoProducto2 xs = aux (reverse (sort xs))
  where aux []     = Nothing
        aux (y:ys) | esProducto y xs = Just y
                   | otherwise       = aux ys

esProducto :: Int -> [Int] -> Bool
esProducto y []     = False
esProducto y (x:xs) = 
  (m == 0 && d `elem` xs) || esProducto y xs
  where (d,m) = divMod y x  

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

--    λ> maximoProducto1 [1..10^4]
--    Just 10000
--    (2.60 secs, 0 bytes)
--    λ> maximoProducto2 [1..10^4]
--    Just 10000
--    (0.01 secs, 0 bytes)

import Data.List (delete, nub, sort)

-- 1ª solución

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

maximoProducto1 :: [Int] -> Maybe Int

maximoProducto1 xs

| null zs = Nothing

| otherwise = Just (head zs)

where

ys = reverse (sort xs)

zs = [y | y <- ys, y `elem` productos xs]

-- (productos xs) es la lista de los números que son productos de dos

-- elementos de xs. Por ejemplo,

-- productos [4,3,5,2] == [12,20,8,15,6,10]

productos :: [Int] -> [Int]

productos xs =

nub [y * z | y <- xs, z <- delete y xs]

-- 2ª solución

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

maximoProducto2 :: [Int] -> Maybe Int

maximoProducto2 xs = aux (reverse (sort xs))

where aux [] = Nothing

aux (y:ys) | esProducto y xs = Just y

| otherwise = aux ys

esProducto :: Int -> [Int] -> Bool

esProducto y [] = False

esProducto y (x:xs) =

(m == 0 && d `elem` xs) || esProducto y xs

where (d,m) = divMod y x

-- Comparación de eficiencia

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

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

-- Just 10000

-- (2.60 secs, 0 bytes)

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

-- Just 10000

-- (0.01 secs, 0 bytes)

Suma minimal de productos de pares de elementos consecutivos

PorJosé A. Alonso 27-enero-20173-febrero-2017

Al permutar los elementos de la lista [1,2,3,4] se obtienen los siguientes valores de la suma de pares de elementos consecutivos:

10, por ejemplo con [1,4,2,3] ya que 1×4+2×3 = 10
11, por ejemplo con [1,3,2,4] ya que 1×3+2×4 = 11
14, por ejemplo con [1,2,3,4] ya que 1×2+3×4 = 14

Por tanto, la mínima suma de los productos de elementos consecutivos en las permutaciones de [1,2,3,4] es 10 y una permutación con dicha suma es [1,4,2,3].

Definir las funciones

   minimaSumaProductos  :: (Num a, Ord a) => [a] -> a
   permutacionMinimal   :: (Num a, Ord a) => [a] -> [a]

1 2	minimaSumaProductos :: (Num a, Ord a) => [a] -> a permutacionMinimal :: (Num a, Ord a) => [a] -> [a]

tales que

(minimaSumaProductos xs) es la mínima suma de los productos de elementos consecutivos en las permutaciones de lista xs, suponiendo que xs tiene un número par de elementos. Por ejemplo,

     minimaSumaProductos [1..4]             ==  10
     minimaSumaProductos [3,2,5,7,1,6]      ==  34
     minimaSumaProductos [9,2,8,4,5,7,6,0]  ==  74
     minimaSumaProductos [1,2,1,4,0,5,6,0]  ==  6

minimaSumaProductos [1..4] == 10

minimaSumaProductos [3,2,5,7,1,6] == 34

minimaSumaProductos [9,2,8,4,5,7,6,0] == 74

minimaSumaProductos [1,2,1,4,0,5,6,0] == 6

(permutacionMinimal xs) es una permutación de xs cuya suma de productos de elementos consecutivos de xs es la mínima suma de los productos de elementos consecutivos en las permutaciones de lista xs, suponiendo que xs tiene un número par de elementos. Por ejemplo,

     permutacionMinimal [1..4]             ==  [1,4,3,2]
     permutacionMinimal [3,2,5,7,1,6]      ==  [1,7,2,6,3,5]
     permutacionMinimal [9,2,8,4,5,7,6,0]  ==  [0,9,2,8,4,7,5,6]
     permutacionMinimal [1,2,1,4,0,5,6,0]  ==  [0,6,0,5,1,4,1,2]

permutacionMinimal [1..4] == [1,4,3,2]

permutacionMinimal [3,2,5,7,1,6] == [1,7,2,6,3,5]

permutacionMinimal [9,2,8,4,5,7,6,0] == [0,9,2,8,4,7,5,6]

permutacionMinimal [1,2,1,4,0,5,6,0] == [0,6,0,5,1,4,1,2]

Soluciones

import Data.List (sort, permutations)
import Test.QuickCheck

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

minimaSumaProductos :: (Num a, Ord a) => [a] -> a
minimaSumaProductos xs =
  minimum [sumaProductos ys | ys <- permutations xs]

--    sumaProductos [3,2,1,4]  ==  10
--    sumaProductos [2,4,3,1]  ==  11
--    sumaProductos [1,2,3,4]  ==  14
sumaProductos :: (Num a, Ord a) => [a] -> a
sumaProductos []       = 0
sumaProductos [x]      = x
sumaProductos (x:y:zs) = x*y + sumaProductos zs

permutacionMinimal :: (Num a, Ord a) => [a] -> [a]
permutacionMinimal xs =
  head [ys | ys <- yss
           , sumaProductos ys == m]
  where yss = permutations xs
        m   = minimaSumaProductos xs

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

permutacionMinimal2 :: (Num a, Ord a) => [a] -> [a]
permutacionMinimal2 xs =
  intercala ys (reverse zs)
  where n = length xs
        (ys,zs) = splitAt (n `div` 2) (sort xs)

intercala :: [a] -> [a] -> [a]
intercala xs ys =
  concat [[x,y] | (x,y) <- zip xs ys]

minimaSumaProductos2 :: (Num a, Ord a) => [a] -> a
minimaSumaProductos2 =
  sumaProductos . permutacionMinimal2

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

prop_equivalencia :: [Int] -> Property
prop_equivalencia xs =
  even (length xs) ==>
  minimaSumaProductos xs == minimaSumaProductos2 xs

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

import Data.List (sort, permutations)

import Test.QuickCheck

-- 1ª definición

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

minimaSumaProductos :: (Num a, Ord a) => [a] -> a

minimaSumaProductos xs =

minimum [sumaProductos ys | ys <- permutations xs]

-- sumaProductos [3,2,1,4] == 10

-- sumaProductos [2,4,3,1] == 11

-- sumaProductos [1,2,3,4] == 14

sumaProductos :: (Num a, Ord a) => [a] -> a

sumaProductos [] = 0

sumaProductos [x] = x

sumaProductos (x:y:zs) = x*y + sumaProductos zs

permutacionMinimal :: (Num a, Ord a) => [a] -> [a]

permutacionMinimal xs =

head [ys | ys <- yss

, sumaProductos ys == m]

where yss = permutations xs

m = minimaSumaProductos xs

-- 2ª definición

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

permutacionMinimal2 :: (Num a, Ord a) => [a] -> [a]

permutacionMinimal2 xs =

intercala ys (reverse zs)

where n = length xs

(ys,zs) = splitAt (n `div` 2) (sort xs)

intercala :: [a] -> [a] -> [a]

intercala xs ys =

concat [[x,y] | (x,y) <- zip xs ys]

minimaSumaProductos2 :: (Num a, Ord a) => [a] -> a

minimaSumaProductos2 =

sumaProductos . permutacionMinimal2

-- Equivalencia

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

prop_equivalencia :: [Int] -> Property

prop_equivalencia xs =

even (length xs) ==>

minimaSumaProductos xs == minimaSumaProductos2 xs

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Máxima potencia que divide al factorial

PorJosé A. Alonso 26-enero-20172-febrero-2017

La máxima potencia de 2 que divide al factorial de 5 es 3, ya que 5! = 120, 120 es divisible por 2^3 y no lo es por 2^4.

Definir la función

   maxPotDivFact :: Integer -> Integer -> Integer

1	maxPotDivFact :: Integer -> Integer -> Integer

tal que (maxPotDivFact p n), para cada primo p, es el mayor k tal que p^k divide al factorial de n. Por ejemplo,

   maxPotDivFact 2 5       ==  3
   maxPotDivFact 3 6       ==  2
   maxPotDivFact 2 10      ==  8
   maxPotDivFact 3 10      ==  4
   maxPotDivFact 2 (10^2)  ==  97
   maxPotDivFact 2 (10^3)  ==  994
   maxPotDivFact 2 (10^4)  ==  9995
   maxPotDivFact 2 (10^5)  ==  99994
   maxPotDivFact 2 (10^6)  ==  999993
   maxPotDivFact 3 (10^5)  ==  49995
   maxPotDivFact 3 (10^6)  ==  499993
   maxPotDivFact 7 (10^5)  ==  16662
   maxPotDivFact 7 (10^6)  ==  166664
   length (show (maxPotDivFact 2 (10^20000)))  ==  20000

maxPotDivFact 2 5 == 3

maxPotDivFact 3 6 == 2

maxPotDivFact 2 10 == 8

maxPotDivFact 3 10 == 4

maxPotDivFact 2 (10^2) == 97

maxPotDivFact 2 (10^3) == 994

maxPotDivFact 2 (10^4) == 9995

maxPotDivFact 2 (10^5) == 99994

maxPotDivFact 2 (10^6) == 999993

maxPotDivFact 3 (10^5) == 49995

maxPotDivFact 3 (10^6) == 499993

maxPotDivFact 7 (10^5) == 16662

maxPotDivFact 7 (10^6) == 166664

length (show (maxPotDivFact 2 (10^20000))) == 20000

Soluciones

import Data.List (genericIndex, genericTake)
import Data.Numbers.Primes (primes)
import Test.QuickCheck

-- 1ª definición
maxPotDivFact :: Integer -> Integer -> Integer
maxPotDivFact p n =
  head [k | k <- [0..], f `mod` (p^k) /= 0] - 1
  where f = product [1..n]

-- 1ª definición
maxPotDivFact2 :: Integer -> Integer -> Integer
maxPotDivFact2 p n
  | n < p     = 0
  | otherwise = m + maxPotDivFact2 p m
  where m = n `div` p  
  
-- 3ª definición
maxPotDivFact3 :: Integer -> Integer -> Integer
maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia
--    λ> maxPotDivFact 2 (10^4)
--    9995
--    (5.47 secs, 161,040,624 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--
--    λ> length (show (maxPotDivFact2 2 (10^20000)))
--    20000
--    (1.93 secs, 592,168,544 bytes)
--    λ> length (show (maxPotDivFact3 2 (10^20000)))
--    20000
--    (2.93 secs, 861,791,504 bytes)

import Data.List (genericIndex, genericTake)

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª definición

maxPotDivFact :: Integer -> Integer -> Integer

maxPotDivFact p n =

head [k | k <- [0..], f `mod` (p^k) /= 0] - 1

where f = product [1..n]

-- 1ª definición

maxPotDivFact2 :: Integer -> Integer -> Integer

maxPotDivFact2 p n

| n < p = 0

| otherwise = m + maxPotDivFact2 p m

where m = n `div` p

-- 3ª definición

maxPotDivFact3 :: Integer -> Integer -> Integer

maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia

-- λ> maxPotDivFact 2 (10^4)

-- 9995

-- (5.47 secs, 161,040,624 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> length (show (maxPotDivFact2 2 (10^20000)))

-- 20000

-- (1.93 secs, 592,168,544 bytes)

-- λ> length (show (maxPotDivFact3 2 (10^20000)))

-- 20000

-- (2.93 secs, 861,791,504 bytes)

Árboles continuos

PorJosé A. Alonso 25-enero-20171-febrero-2017

Los árboles binarios se pueden representar con el de tipo de dato algebraico

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, los árboles

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

3 7

/ \ / \

2 4 5 8

/ \ \ / \ \

1 3 5 6 4 10

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
   ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

ej1, ej2 :: Arbol Int

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

Un árbol binario es continuo si el valor absoluto de la diferencia de los elementos adyacentes es 1. Por ejemplo, el árbol ej1 es continuo ya que el valor absoluto de sus pares de elementos adyacentes son

   |3-2| = |2-1| = |2-3| = |3-4| = |4-5| = 1

1	\|3-2\| = \|2-1\| = \|2-3\| = \|3-4\| = \|4-5\| = 1

En cambio, el ej2 no lo es ya que |8-10| ≠ 1.

Definir la función

   esContinuo :: (Num a, Eq a) => Arbol a -> Bool

1	esContinuo :: (Num a, Eq a) => Arbol a -> Bool

tal que (esContinuo x) se verifica si el árbol x es continuo. Por ejemplo,

   esContinuo ej1  ==  True
   esContinuo ej2  ==  False

1 2	esContinuo ej1 == True esContinuo ej2 == False

Soluciones

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

ej1, ej2 :: Arbol Int
ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

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

esContinuo :: (Num a, Eq a) => Arbol a -> Bool
esContinuo H         = True
esContinuo (N _ H H) = True
esContinuo (N x i@(N y _ _) H) =
  abs (x - y) == 1 && esContinuo i
esContinuo (N x H d@(N y _ _)) =
  abs (x - y) == 1 && esContinuo d
esContinuo (N x i@(N y _ _) d@(N z _ _)) =
  abs (x - y) == 1 && esContinuo i && abs (x - z) == 1 && esContinuo d 

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

esContinuo2 :: (Num a, Eq a) => Arbol a -> Bool
esContinuo2 x =
  all esContinua (ramas x)

-- (ramas x) es la lista de las ramas del árbol x. Por ejemplo,
--    ramas ej1  ==  [[3,2,1],[3,2,3],[3,4,5]]
--    ramas ej2  ==  [[7,5,6],[7,5,4],[7,8,10]]
ramas :: Arbol a -> [[a]]
ramas H         = []
ramas (N x H H) = [[x]]
ramas (N x i d) = [x : xs | xs <- ramas i ++ ramas d]

-- (esContinua xs) se verifica si el valor absoluto de la diferencia de
-- los elementos adyacentes de xs es 1. Por ejemplo, 
--    esContinua [3,2,3]   ==  True
--    esContinua [7,8,10]  ==  False
esContinua :: (Num a, Eq a) => [a] -> Bool
esContinua xs =
  and [abs (x - y) == 1 | (x, y) <- zip xs (tail xs)]

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

-- 1ª solución

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

esContinuo :: (Num a, Eq a) => Arbol a -> Bool

esContinuo H = True

esContinuo (N _ H H) = True

esContinuo (N x i@(N y _ _) H) =

abs (x - y) == 1 && esContinuo i

esContinuo (N x H d@(N y _ _)) =

abs (x - y) == 1 && esContinuo d

esContinuo (N x i@(N y _ _) d@(N z _ _)) =

abs (x - y) == 1 && esContinuo i && abs (x - z) == 1 && esContinuo d

-- 2ª solución

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

esContinuo2 :: (Num a, Eq a) => Arbol a -> Bool

esContinuo2 x =

all esContinua (ramas x)

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

-- ramas ej1 == [[3,2,1],[3,2,3],[3,4,5]]

-- ramas ej2 == [[7,5,6],[7,5,4],[7,8,10]]

ramas :: Arbol a -> [[a]]

ramas H = []

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

ramas (N x i d) = [x : xs | xs <- ramas i ++ ramas d]

-- (esContinua xs) se verifica si el valor absoluto de la diferencia de

-- los elementos adyacentes de xs es 1. Por ejemplo,

-- esContinua [3,2,3] == True

-- esContinua [7,8,10] == False

esContinua :: (Num a, Eq a) => [a] -> Bool

esContinua xs =

and [abs (x - y) == 1 | (x, y) <- zip xs (tail xs)]

Referencias

Basado en Continuous tree de GeeksforGeeks.

La conjetura de Rodolfo

PorJosé A. Alonso 19-enero-201726-enero-2017

El pasado 1 de enero, Claudio Meller publicó el artículo La conjetura de Rodolfo que afirma que

Todos los números naturales se pueden números pueden expresarse como la suma de un capicúa y un capicúa especial (siendo los capicúas especiales los números que al quitarles los ceros finales son capicúas; por ejemplo, 32300, 50500 y 78987).

Definir las funciones

   descomposiciones               :: Integer -> [(Integer, Integer)]
   contraejemplosConjeturaRodolfo :: [Integer]

1 2	descomposiciones :: Integer -> [(Integer, Integer)] contraejemplosConjeturaRodolfo :: [Integer]

tales que

(descomposiciones x) es la lista de las descomposiciones de x como la suma de un capicúa y un capicúa especial. Por ejemplo,

     descomposiciones 1980  ==  [(99,1881),(979,1001)]
     descomposiciones 2016  ==  [(575,1441),(606,1410)]
     descomposiciones 1971  ==  [(161,1810),(1771,200),(1881,90)]

descomposiciones 1980 == [(99,1881),(979,1001)]

descomposiciones 2016 == [(575,1441),(606,1410)]

descomposiciones 1971 == [(161,1810),(1771,200),(1881,90)]

contraejemplosConjeturaRodolfo es la lista de contraejemplos de la conjetura de Rodolfo; es decir, de los números que no pueden expresarse com la suma de un capicúa y un capicúa especial. Por ejemplo,

     λ> take 12 contraejemplosConjeturaRodolfo
     [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
     λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
     [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

λ> take 12 contraejemplosConjeturaRodolfo

[1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

[3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

Soluciones

import Data.List (nub)

descomposiciones :: Integer -> [(Integer, Integer)]
descomposiciones x =
  reducida [(y,z) | y <- takeWhile (<= x) capicuas
                  , let z = x - y
                  , esCapicuaG z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x

esCapicuaG :: Integer -> Bool
esCapicuaG x =
  x == 0 || esCapicua (sinCerosFinales x)

--    sinCerosFinales 3405000  ==  3405
sinCerosFinales :: Integer -> Integer
sinCerosFinales x =
  read (reverse (dropWhile (== '0') (reverse (show x))))

reducida :: [(Integer, Integer)] -> [(Integer, Integer)]
reducida ps =
  nub [(x,y) | (x,y) <- ps
             , x <= y]

--    λ> take 12 contraejemplosConjeturaRodolfo
--    [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
--    λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
--    [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]
contraejemplosConjeturaRodolfo :: [Integer]
contraejemplosConjeturaRodolfo =
  [x | x <- [0..]
  , null (descomposiciones x)]

import Data.List (nub)

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

descomposiciones x =

reducida [(y,z) | y <- takeWhile (<= x) capicuas

, let z = x - y

, esCapicuaG z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

esCapicuaG :: Integer -> Bool

esCapicuaG x =

x == 0 || esCapicua (sinCerosFinales x)

-- sinCerosFinales 3405000 == 3405

sinCerosFinales :: Integer -> Integer

sinCerosFinales x =

read (reverse (dropWhile (== '0') (reverse (show x))))

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

reducida ps =

nub [(x,y) | (x,y) <- ps

, x <= y]

-- λ> take 12 contraejemplosConjeturaRodolfo

-- [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

-- λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

-- [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

contraejemplosConjeturaRodolfo :: [Integer]

contraejemplosConjeturaRodolfo =

[x | x <- [0..]

, null (descomposiciones x)]

Sumas de dos capicúas

PorJosé A. Alonso 17-enero-201724-enero-2017

Definir las funciones

   sumas2Capicuas  :: Integer -> [(Integer, Integer)]
   noSuma2Capicuas :: [Integer]

1 2	sumas2Capicuas :: Integer -> [(Integer, Integer)] noSuma2Capicuas :: [Integer]

tales que

(sumas2Capicuas x) es la lista de las descomposiciones de x como suma de dos capicúas (con el primer sumando menor o igual que el segundo). Por ejemplo,

      sumas2Capicuas 17  == [(6,11),(8,9)]
      sumas2Capicuas 187 == [(6,181),(66,121),(88,99)]
      sumas2Capicuas 165 == [(4,161),(44,121),(66,99),(77,88)]
      sumas2Capicuas 382 == [(9,373),(191,191)]
      sumas2Capicuas 151 == [(0,151)]
      sumas2Capicuas 201 == []

sumas2Capicuas 17 == [(6,11),(8,9)]

sumas2Capicuas 187 == [(6,181),(66,121),(88,99)]

sumas2Capicuas 165 == [(4,161),(44,121),(66,99),(77,88)]

sumas2Capicuas 382 == [(9,373),(191,191)]

sumas2Capicuas 151 == [(0,151)]

sumas2Capicuas 201 == []

noSuma2Capicuas es la sucesión de los números que no se pueden escribir como suma de dos capicúas. Por ejemplo,

      λ> take 15 noSuma2Capicuas
      [21,32,43,54,65,76,87,98,201,1031,1041,1042,1051,1052,1053]
      λ> noSuma2Capicuas !! 3000
      19941

λ> take 15 noSuma2Capicuas

[21,32,43,54,65,76,87,98,201,1031,1041,1042,1051,1052,1053]

λ> noSuma2Capicuas !! 3000

19941

Soluciones

sumas2Capicuas :: Integer -> [(Integer, Integer)]
sumas2Capicuas x =
  [(y,z) | y <- takeWhile (<= (x `div` 2)) capicuas
         , let z = x - y
         , esCapicua z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x

noSuma2Capicuas :: [Integer]
noSuma2Capicuas =
  [x | x <- [0..]
     , null (sumas2Capicuas x)]

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

sumas2Capicuas x =

[(y,z) | y <- takeWhile (<= (x `div` 2)) capicuas

, let z = x - y

, esCapicua z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

noSuma2Capicuas :: [Integer]

noSuma2Capicuas =

[x | x <- [0..]

, null (sumas2Capicuas x)]

Sumas de tres capicúas

PorJosé A. Alonso 12-enero-201719-enero-2017

Definir la función

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

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

tales que (sumas3Capicuas x) es la lista de las descomposiciones de x como suma de tres capicúas (con los sumandos no decrecientes). Por ejemplo,

   sumas3Capicuas 0  ==  [(0,0,0)]
   sumas3Capicuas 1  ==  [(0,0,1)]
   sumas3Capicuas 2  ==  [(0,0,2),(0,1,1)]
   sumas3Capicuas 3  ==  [(0,0,3),(0,1,2),(1,1,1)]
   sumas3Capicuas 4  ==  [(0,0,4),(0,1,3),(0,2,2),(1,1,2)]
   length (sumas3Capicuas 17)      ==  17
   length (sumas3Capicuas 2017)    ==  47
   length (sumas3Capicuas 999999)  ==  15266

sumas3Capicuas 0 == [(0,0,0)]

sumas3Capicuas 1 == [(0,0,1)]

sumas3Capicuas 2 == [(0,0,2),(0,1,1)]

sumas3Capicuas 3 == [(0,0,3),(0,1,2),(1,1,1)]

sumas3Capicuas 4 == [(0,0,4),(0,1,3),(0,2,2),(1,1,2)]

length (sumas3Capicuas 17) == 17

length (sumas3Capicuas 2017) == 47

length (sumas3Capicuas 999999) == 15266

Comprobar con QuickCheck que todo número natural se puede escribir como suma de tres capicúas.

Soluciones

import Test.QuickCheck

sumas3Capicuas :: Integer -> [(Integer, Integer, Integer)]
sumas3Capicuas x =
  [(a,b,c) | a <- as
           , b <- dropWhile (< a) as
           , let c = x - a - b
           , b <= c 
           , esCapicua c]
  where as = takeWhile (<= x) capicuas

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x

-- La propiedad es
prop_sumas3Capicuas :: Integer -> Property
prop_sumas3Capicuas x =
  x >= 0 ==> not (null (sumas3Capicuas x))

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

import Test.QuickCheck

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

sumas3Capicuas x =

[(a,b,c) | a <- as

, b <- dropWhile (< a) as

, let c = x - a - b

, b <= c

, esCapicua c]

where as = takeWhile (<= x) capicuas

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

-- La propiedad es

prop_sumas3Capicuas :: Integer -> Property

prop_sumas3Capicuas x =

x >= 0 ==> not (null (sumas3Capicuas x))

-- La comprobación es

-- λ> quickCheck prop_sumas3Capicuas

-- +++ OK, passed 100 tests.

Sucesión de capicúas

PorJosé A. Alonso 11-enero-201718-enero-2017

Definir las funciones

   capicuas        :: [Integer] 
   posicionCapicua :: Integer -> Integer

1 2	capicuas :: [Integer] posicionCapicua :: Integer -> Integer

tales que

capicuas es la sucesión de los números capicúas. Por ejemplo,

   λ> take 45 capicuas
   [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
    141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
    303,313,323,333,343,353]
   λ> capicuas !! (10^5)  
   900010009

λ> take 45 capicuas

[0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

303,313,323,333,343,353]

λ> capicuas !! (10^5)

900010009

(posicionCapicua x) es la posición del número capicúa x en la sucesión de los capicúas. Por ejemplo,

   λ> posicionCapicua 353
   44
   λ> posicionCapicua 900010009
   100000
   λ> let xs = show (123^30)
   λ> posicionCapicua (read (xs ++ reverse xs))
   1497912859868342793044999075260564303046944727069807798026337448
   λ> posicionCapicua (read (xs ++ "7" ++ reverse xs))
   5979128598683427930449990752605643030469447270698077980263374496

λ> posicionCapicua 353

λ> posicionCapicua 900010009

100000

λ> let xs = show (123^30)

λ> posicionCapicua (read (xs ++ reverse xs))

1497912859868342793044999075260564303046944727069807798026337448

λ> posicionCapicua (read (xs ++ "7" ++ reverse xs))

5979128598683427930449990752605643030469447270698077980263374496

Soluciones

import Data.List (genericLength)

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

capicuas1 :: [Integer]
capicuas1 = [n | n <- [0..]
               , esCapicua n]

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x


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

capicuas2 :: [Integer]
capicuas2 = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

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

capicuas3 :: [Integer]
capicuas3 = iterate sigCapicua 0

-- (sigCapicua x) es el capicúa siguiente del número x. Por ejemplo,
--    sigCapicua 12321           == 12421
--    sigCapicua 1298921         == 1299921
--    sigCapicua 999             == 1001
--    sigCapicua 9999            == 10001
--    sigCapicua 898             == 909
--    sigCapicua 123456777654321 == 123456787654321
sigCapicua :: Integer -> Integer
sigCapicua n = read cs
    where l  = length (show (n+1))
          k  = l `div` 2
          xs = show ((n `div` (10^k)) + 1) 
          cs = xs ++ drop (l `rem` 2) (reverse xs)

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

capicuas4 :: [Integer]
capicuas4 =
  concatMap generaCapicuas4 [1..]

generaCapicuas4 :: Integer -> [Integer]
generaCapicuas4 1 = [0..9]
generaCapicuas4 n
  | even n    = [read (xs ++ reverse xs)
                | xs <- map show [10^(m-1)..10^m-1]]
  | otherwise = [read (xs ++ (y : reverse xs))
                | xs <- map show [10^(m-1)..10^m-1]
                , y <- "0123456789"]
  where m = n `div` 2

-- 5ª definición de capicuas
-- =========================

capicuas5 :: [Integer]
capicuas5 = 0 : aux 1
  where aux n =    [read (show x ++ tail (reverse (show x)))
                   | x <- [10^(n-1)..10^n-1]]
                ++ [read (show x ++ reverse (show x))
                   | x <- [10^(n-1)..10^n-1]]
                ++ aux (n+1)

-- 6ª definición de capicuas
-- =========================

capicuas6 :: [Integer]
capicuas6 = 0 : map read (capicuas6Aux [1..9])
 
capicuas6Aux :: [Integer] -> [String]
capicuas6Aux xs =  map duplica1 ys
                ++ map duplica2 ys
                ++ capicuas6Aux [head xs * 10 .. last xs * 10 + 9]
  where
    ys          = map show xs
    duplica1 cs = cs ++ tail (reverse cs)
    duplica2 cs = cs ++ reverse cs

-- 7ª definición de capicuas
-- =========================

capicuas7 :: [Integer]
capicuas7 = 0 : map read (capicuas7Aux [1..9])
 
capicuas7Aux :: [Integer] -> [String]
capicuas7Aux xs =  map duplica1 ys
                ++ map duplica2 ys
                ++ capicuas7Aux [head xs * 10 .. last xs * 10 + 9]
  where
    ys       = map show xs
    duplica1 = (++) <$> id <*> tail . reverse
    duplica2 = (++) <$> id <*> reverse

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

--    λ> capicuas1 !! 2000
--    1001001
--    (2.25 secs, 598,879,552 bytes)
--    λ> capicuas2 !! 2000
--    1001001
--    (0.05 secs, 28,630,552 bytes)
--    λ> capicuas3 !! 2000
--    1001001
--    (0.06 secs, 14,721,360 bytes)
--    λ> capicuas4 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas5 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas6 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas7 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    
--    λ> capicuas2 !! (10^5)
--    900010009
--    (2.03 secs, 1,190,503,952 bytes)
--    λ> capicuas3 !! (10^5)
--    900010009
--    (5.12 secs, 1,408,876,328 bytes)
--    λ> capicuas4 !! (10^5)
--    900010009
--    (0.21 secs, 8,249,296 bytes)
--    λ> capicuas5 !! (10^5)
--    900010009
--    (0.10 secs, 31,134,176 bytes)
--    λ> capicuas6 !! (10^5)
--    900010009
--    (0.14 secs, 55,211,272 bytes)
--    λ> capicuas7 !! (10^5)
--    900010009
--    (0.03 secs, 0 bytes)

-- 1ª definición de posicionCapicua
posicionCapicua1 :: Integer -> Integer
posicionCapicua1 x =
  genericLength (takeWhile (< x) capicuas7)

-- 2ª definición
posicionCapicua2 :: Integer -> Integer
posicionCapicua2 x
  | even n    = read ('1' : take (n `div` 2) xs) - 1
  | otherwise = read (show (1 + read [y]) ++ take (n `div` 2) ys) - 1
  where xs@(y:ys) = show x
        n         = genericLength xs

-- Comparación de eficiencia
--    λ> posicionCapicua1 (10^9 - 1)
--    109998
--    (1.98 secs, 1,112,991,520 bytes)
--    λ> posicionCapicua2 (10^9 - 1)
--    109998
--    (0.01 secs, 0 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

import Data.List (genericLength)

-- 1ª definición de capicuas

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

capicuas1 :: [Integer]

capicuas1 = [n | n <- [0..]

, esCapicua n]

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

-- 2ª definición de capicuas

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

capicuas2 :: [Integer]

capicuas2 = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

mezcla us@(x:xs) vs@(y:ys)

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª definición de capicuas

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

capicuas3 :: [Integer]

capicuas3 = iterate sigCapicua 0

-- (sigCapicua x) es el capicúa siguiente del número x. Por ejemplo,

-- sigCapicua 12321 == 12421

-- sigCapicua 1298921 == 1299921

-- sigCapicua 999 == 1001

-- sigCapicua 9999 == 10001

-- sigCapicua 898 == 909

-- sigCapicua 123456777654321 == 123456787654321

sigCapicua :: Integer -> Integer

sigCapicua n = read cs

where l = length (show (n+1))

k = l `div` 2

xs = show ((n `div` (10^k)) + 1)

cs = xs ++ drop (l `rem` 2) (reverse xs)

-- 4ª definición de capicuas

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

capicuas4 :: [Integer]

capicuas4 =

concatMap generaCapicuas4 [1..]

generaCapicuas4 :: Integer -> [Integer]

generaCapicuas4 1 = [0..9]

generaCapicuas4 n

| even n = [read (xs ++ reverse xs)

| xs <- map show [10^(m-1)..10^m-1]]

| otherwise = [read (xs ++ (y : reverse xs))

| xs <- map show [10^(m-1)..10^m-1]

, y <- "0123456789"]

where m = n `div` 2

-- 5ª definición de capicuas

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

capicuas5 :: [Integer]

capicuas5 = 0 : aux 1

where aux n = [read (show x ++ tail (reverse (show x)))

| x <- [10^(n-1)..10^n-1]]

++ [read (show x ++ reverse (show x))

| x <- [10^(n-1)..10^n-1]]

++ aux (n+1)

-- 6ª definición de capicuas

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

capicuas6 :: [Integer]

capicuas6 = 0 : map read (capicuas6Aux [1..9])

capicuas6Aux :: [Integer] -> [String]

capicuas6Aux xs = map duplica1 ys

++ map duplica2 ys

++ capicuas6Aux [head xs * 10 .. last xs * 10 + 9]

where

ys = map show xs

duplica1 cs = cs ++ tail (reverse cs)

duplica2 cs = cs ++ reverse cs

-- 7ª definición de capicuas

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

capicuas7 :: [Integer]

capicuas7 = 0 : map read (capicuas7Aux [1..9])

capicuas7Aux :: [Integer] -> [String]

capicuas7Aux xs = map duplica1 ys

++ map duplica2 ys

++ capicuas7Aux [head xs * 10 .. last xs * 10 + 9]

where

ys = map show xs

duplica1 = (++) <$> id <*> tail . reverse

duplica2 = (++) <$> id <*> reverse

-- Comparación de eficiencia

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

-- λ> capicuas1 !! 2000

-- 1001001

-- (2.25 secs, 598,879,552 bytes)

-- λ> capicuas2 !! 2000

-- 1001001

-- (0.05 secs, 28,630,552 bytes)

-- λ> capicuas3 !! 2000

-- 1001001

-- (0.06 secs, 14,721,360 bytes)

-- λ> capicuas4 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas5 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas6 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas7 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas2 !! (10^5)

-- 900010009

-- (2.03 secs, 1,190,503,952 bytes)

-- λ> capicuas3 !! (10^5)

-- 900010009

-- (5.12 secs, 1,408,876,328 bytes)

-- λ> capicuas4 !! (10^5)

-- 900010009

-- (0.21 secs, 8,249,296 bytes)

-- λ> capicuas5 !! (10^5)

-- 900010009

-- (0.10 secs, 31,134,176 bytes)

-- λ> capicuas6 !! (10^5)

-- 900010009

-- (0.14 secs, 55,211,272 bytes)

-- λ> capicuas7 !! (10^5)

-- 900010009

-- (0.03 secs, 0 bytes)

-- 1ª definición de posicionCapicua

posicionCapicua1 :: Integer -> Integer

posicionCapicua1 x =

genericLength (takeWhile (< x) capicuas7)

-- 2ª definición

posicionCapicua2 :: Integer -> Integer

posicionCapicua2 x

| even n = read ('1' : take (n `div` 2) xs) - 1

| otherwise = read (show (1 + read [y]) ++ take (n `div` 2) ys) - 1

where xs@(y:ys) = show x

n = genericLength xs

-- Comparación de eficiencia

-- λ> posicionCapicua1 (10^9 - 1)

-- 109998

-- (1.98 secs, 1,112,991,520 bytes)

-- λ> posicionCapicua2 (10^9 - 1)

-- 109998

-- (0.01 secs, 0 bytes)

Números dorados

PorJosé A. Alonso 6-enero-201713-enero-2017

Los dígitos del número 2375 se pueden separar en dos grupos de igual tamaño ([7,2] y [5,3]) tales que para los correspondientes números (72 y 53) se verifique que la diferencia de sus cuadrados sea el número original (es decir, 72^2 – 53^2 = 2375).

Un número x es dorado si sus dígitos se pueden separar en dos grupos de igual tamaño tales que para los correspondientes números (a y b) se verifique que la diferencia de sus cuadrados sea el número original (es decir, b^2 – a^2 = x).

Definir la función

   esDorado :: Integer -> Bool

1	esDorado :: Integer -> Bool

tales que (esDorado x) se verifica si x es un número dorado. Por
ejemplo,

   λ> esDorado 2375
   True
   λ> take 5 [x | x <- [1..], esDorado x]
   [48,1023,1404,2325,2375]

λ> esDorado 2375

True

λ> take 5 [x | x <- [1..], esDorado x]

[48,1023,1404,2325,2375]

Soluciones

import Data.List (permutations)

esDorado :: Integer -> Bool
esDorado x =
  even (length (show x)) &&
  or [b^2 - a^2 == x | (a,b) <- particionesNumero x]

-- (particiones xs) es la lista de las formas de dividir xs en dos
-- partes de igual longitud (se supone que xs tiene un número par de
-- elementos). Por ejemplo,
--    λ> particiones "abcd"
--    [("ab","cd"),("ba","cd"),("cb","ad"),("bc","ad"),("ca","bd"),
--     ("ac","bd"),("dc","ba"),("cd","ba"),("cb","da"),("db","ca"),
--     ("bd","ca"),("bc","da"),("da","bc"),("ad","bc"),("ab","dc"),
--     ("db","ac"),("bd","ac"),("ba","dc"),("da","cb"),("ad","cb"),
--     ("ac","db"),("dc","ab"),("cd","ab"),("ca","db")]
particiones :: [a] -> [([a],[a])]
particiones xs =
  [splitAt m ys | ys <- permutations xs]
  where m = length xs `div` 2

-- (particionesNumero n) es la lista de las formas de dividir n en dos
-- partes de igual longitud (se supone que n tiene un número par de
-- dígitos). Por ejemplo,
--    λ> particionesNumero 1234
--    [(12,34),(21,34),(32,14),(23,14),(31,24),(13,24),(43,21),(34,21),
--     (32,41),(42,31),(24,31),(23,41),(41,23),(14,23),(12,43),(42,13),
--     (24,13),(21,43),(41,32),(14,32),(13,42),(43,12),(34,12),(31,42)]
particionesNumero :: Integer -> [(Integer,Integer)]
particionesNumero n =
  [(read xs,read ys) | (xs,ys) <- particiones (show n)]

import Data.List (permutations)

esDorado :: Integer -> Bool

esDorado x =

even (length (show x)) &&

or [b^2 - a^2 == x | (a,b) <- particionesNumero x]

-- (particiones xs) es la lista de las formas de dividir xs en dos

-- partes de igual longitud (se supone que xs tiene un número par de

-- elementos). Por ejemplo,

-- λ> particiones "abcd"

-- [("ab","cd"),("ba","cd"),("cb","ad"),("bc","ad"),("ca","bd"),

-- ("ac","bd"),("dc","ba"),("cd","ba"),("cb","da"),("db","ca"),

-- ("bd","ca"),("bc","da"),("da","bc"),("ad","bc"),("ab","dc"),

-- ("db","ac"),("bd","ac"),("ba","dc"),("da","cb"),("ad","cb"),

-- ("ac","db"),("dc","ab"),("cd","ab"),("ca","db")]

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

particiones xs =

[splitAt m ys | ys <- permutations xs]

where m = length xs `div` 2

-- (particionesNumero n) es la lista de las formas de dividir n en dos

-- partes de igual longitud (se supone que n tiene un número par de

-- dígitos). Por ejemplo,

-- λ> particionesNumero 1234

-- [(12,34),(21,34),(32,14),(23,14),(31,24),(13,24),(43,21),(34,21),

-- (32,41),(42,31),(24,31),(23,41),(41,23),(14,23),(12,43),(42,13),

-- (24,13),(21,43),(41,32),(14,32),(13,42),(43,12),(34,12),(31,42)]

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

particionesNumero n =

[(read xs,read ys) | (xs,ys) <- particiones (show n)]

Estratificación de un árbol

PorJosé A. Alonso 3-enero-201710-enero-2017

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

   data Arbol a = N a [Arbol a]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

8 3 8 3 8 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

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

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

Un estrato de un árbol es la lista de nodos que se encuentran al mismo nivel de profundidad. Por ejemplo, los estratos del árbol ej1 son [1], [8,3] y [4].

Definir la función

   estratos :: Arbol a -> [[a]]

1	estratos :: Arbol a -> [[a]]

tal que (estratos x) es la lista de los estratos del árbol x. Por ejemplo,

   estratos ej1 == [[1],[8,3],[4]]
   estratos ej2 == [[1],[8,3],[4,5,6]]
   estratos ej3 == [[1],[8,3],[4,5,6,7]]

estratos ej1 == [[1],[8,3],[4]]

estratos ej2 == [[1],[8,3],[4,5,6]]

estratos ej3 == [[1],[8,3],[4,5,6,7]]

Soluciones

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

estratos :: Arbol a -> [[a]]
estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,
--    estrato 0 ej1  ==  [1]
--    estrato 1 ej1  ==  [8,3]
--    estrato 2 ej1  ==  [4]
--    estrato 4 ej1  ==  []
estrato :: Int -> Arbol a ->  [a]
estrato 0 (N x _)  = [x]
estrato n (N _ xs) = concatMap (estrato (n-1)) xs

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

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

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

estratos :: Arbol a -> [[a]]

estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,

-- estrato 0 ej1 == [1]

-- estrato 1 ej1 == [8,3]

-- estrato 2 ej1 == [4]

-- estrato 4 ej1 == []

estrato :: Int -> Arbol a -> [a]

estrato 0 (N x _) = [x]

estrato n (N _ xs) = concatMap (estrato (n-1)) xs

Terminaciones de Fibonacci

PorJosé A. Alonso 2-enero-20179-enero-2017

Definir la sucesión

   sucFinalesFib :: [(Integer,Integer)]

1	sucFinalesFib :: [(Integer,Integer)]

cuyos elementos son los pares (n,x), donde x es el n-ésimo término de la sucesión de Fibonacci, tales que la terminación de x es n. Por ejemplo,

   λ> take 6 sucFinalesFib
   [(0,0),(1,1),(5,5),(25,75025),(29,514229),(41,165580141)]
   λ> head [(n,x) | (n,x) <- sucFinalesFib, n > 200]
   (245,712011255569818855923257924200496343807632829750245)
   λ> head [n | (n,_) <- sucFinalesFib, n > 10^4]
   10945

λ> take 6 sucFinalesFib

[(0,0),(1,1),(5,5),(25,75025),(29,514229),(41,165580141)]

λ> head [(n,x) | (n,x) <- sucFinalesFib, n > 200]

(245,712011255569818855923257924200496343807632829750245)

λ> head [n | (n,_) <- sucFinalesFib, n > 10^4]

10945

Soluciones

import Data.List (genericIndex, isSuffixOf)

sucFinalesFib :: [(Integer, Integer)]
sucFinalesFib =
  [(n, fib n) | n <- [0..]
              , show n `isSuffixOf` show (fib n)]

sucFib :: [Integer]
sucFib = 0 : 1 : zipWith (+) sucFib (tail sucFib)

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci.
fib :: Integer -> Integer
fib n = sucFib `genericIndex` n

import Data.List (genericIndex, isSuffixOf)

sucFinalesFib :: [(Integer, Integer)]

sucFinalesFib =

[(n, fib n) | n <- [0..]

, show n `isSuffixOf` show (fib n)]

sucFib :: [Integer]

sucFib = 0 : 1 : zipWith (+) sucFib (tail sucFib)

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci.

fib :: Integer -> Integer

fib n = sucFib `genericIndex` n

Segmentos comunes maximales

PorJosé A. Alonso 30-diciembre-20167-enero-2017

Los segmentos de «abcd» son

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

1	["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

Los segmentos comunes de «abcd» y «axbce» son

   ["","a","b","bc","c"]

1	["","a","b","bc","c"]

Los segmentos comunes maximales (es decir, no contenidos en otros segmentos) de «abcd» y «axbce» son

   ["a","bc"]

1	["a","bc"]

Definir la función

   segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

1	segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

tal que (segmentosComunesMaximales xs ys) es la lista de los segmentos comunes maximales de xs e ys. Por ejemplo,

   segmentosComunesMaximales "abcd" "axbce"  ==  ["a","bc"]
   segmentosComunesMaximales [8,8] [8]       ==  [[8]]

1 2	segmentosComunesMaximales "abcd" "axbce" == ["a","bc"] segmentosComunesMaximales [8,8] [8] == [[8]]

Soluciones

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]
segmentosComunesMaximales xs ys =
  nub [zs | zs <- zss
          , null [us | us <- zss, zs `isInfixOf` us, us /= zs]]
  where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]
segmentosComunes xs ys =
  [zs | zs <- segmentos xs
      , zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    segmentos "abc"  ==  ["","a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
  [] : concatMap (tail . inits) (init (tails xs))

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

segmentosComunesMaximales xs ys =

nub [zs | zs <- zss

, null [us | us <- zss, zs `isInfixOf` us, us /= zs]]

where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]

segmentosComunes xs ys =

[zs | zs <- segmentos xs

, zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- segmentos "abc" == ["","a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concatMap (tail . inits) (init (tails xs))

Números de Perrin

PorJosé A. Alonso 29-diciembre-201625-abril-2021

Los números de Perrin se definen por la relación de recurrencia

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

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

con los valores iniciales

   P(0) = 3, P(1) = 0 y P(2) = 2.

1	P(0) = 3, P(1) = 0 y P(2) = 2.

Definir la sucesión

   sucPerrin :: [Integer]

1	sucPerrin :: [Integer]

cuyos elementos son los números de Perrin. Por ejemplo,

   λ> take 15 sucPerrin
   [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]
   λ> length (show (sucPerrin !! (2*10^5)))
   24425

λ> take 15 sucPerrin

[3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]

λ> length (show (sucPerrin !! (2*10^5)))

24425

Comprobar con QuickCheck si se verifica la siguiente propiedad: para todo entero n > 1, el n-ésimo término de la sucesión de Perrin es divisible por n si y sólo si n es primo.

Soluciones

import Data.List (genericIndex, unfoldr)
import Data.Numbers.Primes (isPrime)
import Test.QuickCheck

-- 1ª definición
sucPerrin1 :: [Integer]
sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª definición
sucPerrin2 :: [Integer]
sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]
  where op (a,b,c) = (b,c,a+b)
 
-- 3ª definición
sucPerrin3 :: [Integer]
sucPerrin3 =
  unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- Comparación de eficiencia
--    λ> length (show (sucPerrin1 !! (10^5)))
--    12213
--    (1.44 secs, 295,373,680 bytes)
--    λ> length (show (sucPerrin2 !! (10^5)))
--    12213
--    (1.22 secs, 301,493,408 bytes)
--    λ> length (show (sucPerrin3 !! (10^5)))
--    12213
--    (0.86 secs, 296,911,304 bytes)

-- Usaremos la 3ª
sucPerrin :: [Integer]
sucPerrin = sucPerrin3

-- La propiedad es  
conjeturaPerrin :: Integer -> Property
conjeturaPerrin n =
  n > 1 ==>
  (perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por
-- ejemplo,
--    perrin 4  ==  2
--    perrin 5  ==  5
--    perrin 6  ==  5
perrin :: Integer -> Integer
perrin n = sucPerrin `genericIndex` n

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

import Data.List (genericIndex, unfoldr)

import Data.Numbers.Primes (isPrime)

import Test.QuickCheck

-- 1ª definición

sucPerrin1 :: [Integer]

sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª definición

sucPerrin2 :: [Integer]

sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]

where op (a,b,c) = (b,c,a+b)

-- 3ª definición

sucPerrin3 :: [Integer]

sucPerrin3 =

unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- Comparación de eficiencia

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

-- 12213

-- (1.44 secs, 295,373,680 bytes)

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

-- 12213

-- (1.22 secs, 301,493,408 bytes)

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

-- 12213

-- (0.86 secs, 296,911,304 bytes)

-- Usaremos la 3ª

sucPerrin :: [Integer]

sucPerrin = sucPerrin3

-- La propiedad es

conjeturaPerrin :: Integer -> Property

conjeturaPerrin n =

n > 1 ==>

(perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por

-- ejemplo,

-- perrin 4 == 2

-- perrin 5 == 5

-- perrin 6 == 5

perrin :: Integer -> Integer

perrin n = sucPerrin `genericIndex` n

-- La comprobación es

-- λ> quickCheck conjeturaPerrin

-- +++ OK, passed 100 tests.

Nota: Aunque QuickCheck no haya encontrado contraejemplos, la propiedad no es cierta. Sólo lo es una de las implicaciones: si n es primo, entonces el n-ésimo término de la sucesión de Perrin es divisible por n. La otra es falsa y los primeros contraejemplos son

   271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

1	271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

Mínima suma de las ramas de un árbol

PorJosé A. Alonso 28-diciembre-201625-marzo-2022

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

   data Arbol a = N a [Arbol a]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

8 3 5 3 5 3

| /|\ /|\ |

4 4 7 6 4 7 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 5 [], N 3 [N 4 [], N 7 [], N 6 []]]

ej3 = N 1 [N 5 [N 4 [], N 7 [], N 6 []], N 3 [N 7 []]]

Definir la función

   minimaSuma :: Arbol Int -> Int

1	minimaSuma :: Arbol Int -> Int

tal que (minimaSuma a) es el mínimo de las sumas de las ramas del árbol a. Por ejemplo,

   minimaSuma ej1  ==  8
   minimaSuma ej2  ==  6
   minimaSuma ej3  ==  10

minimaSuma ej1 == 8

minimaSuma ej2 == 6

minimaSuma ej3 == 10

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show

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


-- 1ª definición
-- =============
minimaSuma :: (Ord a, Num a) => Arbol a -> a
minimaSuma a = minimum [sum xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    ghci> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [[3,5,6],[3,4],[3,7,2],[3,7,1]]
ramas :: Arbol b -> [[b]]
ramas (N x []) = [[x]]
ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª definición
-- =============
  
minimaSuma2 :: Arbol Int -> Int
minimaSuma2 (N x []) = x
minimaSuma2 (N x as) = x + minimum (map minimaSuma2 as)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 8 [],N 3 [N 4 []]]

ej2 = N 1 [N 5 [], N 3 [N 4 [], N 7 [], N 6 []]]

ej3 = N 1 [N 5 [N 4 [], N 7 [], N 6 []], N 3 [N 7 []]]

-- 1ª definición

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

minimaSuma :: (Ord a, Num a) => Arbol a -> a

minimaSuma a = minimum [sum xs | xs <- ramas a]

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

-- ghci> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

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

ramas :: Arbol b -> [[b]]

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

ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª definición

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

minimaSuma2 :: Arbol Int -> Int

minimaSuma2 (N x []) = x

minimaSuma2 (N x as) = x + minimum (map minimaSuma2 as)

Números super pandigitales

PorJosé A. Alonso 27-diciembre-20163-enero-2017

Un entero positivo n es pandigital en base b si su expresión en base b contiene todos los dígitos de 0 a b-1 al menos una vez. Por ejemplo,

el 2 es pandigital en base 2 porque 2 en base 2 es 10,
el 11 es pandigital en base 3 porque 11 en base 3 es 102 y
el 75 es pandigital en base 4 porque 75 en base 4 es 1023.

Un número n es super pandigital de orden m si es pandigital en todas las bases
desde 2 hasta m. Por ejemplo, 978 es super pandigital de orden 5 pues

en base 2 es: 1111010010
en base 3 es: 1100020
en base 4 es: 33102
en base 5 es: 12403

Definir la función

   superPandigitales :: Integer -> [Integer]

1	superPandigitales :: Integer -> [Integer]

tal que (superPandigitales m) es la lista de los números super pandigitales de orden m. Por ejemplo,

   take 3 (superPandigitales 3) == [11,19,21]
   take 3 (superPandigitales 4) == [75,99,114]
   take 3 (superPandigitales 5) == [978,1070,1138]

take 3 (superPandigitales 3) == [11,19,21]

take 3 (superPandigitales 4) == [75,99,114]

take 3 (superPandigitales 5) == [978,1070,1138]

Soluciones

superPandigitales :: Integer -> [Integer]
superPandigitales m =
  [n | n <- [1..]
     , and [pandigitalBase b n | b <- [2..m]]]

-- (pandigitalBase b n) se verifica si n es pandigital en base la base
-- b. Por ejemplo,
--    pandigitalBase 4 75  ==  True
--    pandigitalBase 4 76  ==  False
pandigitalBase :: Integer -> Integer -> Bool
pandigitalBase b n = [0..b-1] `esSubconjunto` enBase b n

-- (enBase b n) es la lista de los dígitos de n en base b. Por ejemplo,
--    enBase 4 75  ==  [3,2,0,1]
--    enBase 4 76  ==  [0,3,0,1]
enBase :: Integer -> Integer -> [Integer]
enBase b n | n < b     = [n]
           | otherwise = n `mod` b : enBase b (n `div` b)

-- (esSubconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    esSubconjunto [1,5] [5,2,1]  ==  True
--    esSubconjunto [1,5] [5,2,3]  ==  False
esSubconjunto :: Eq a => [a] -> [a] -> Bool
esSubconjunto xs ys = all (`elem` ys) xs

superPandigitales :: Integer -> [Integer]

superPandigitales m =

[n | n <- [1..]

, and [pandigitalBase b n | b <- [2..m]]]

-- (pandigitalBase b n) se verifica si n es pandigital en base la base

-- b. Por ejemplo,

-- pandigitalBase 4 75 == True

-- pandigitalBase 4 76 == False

pandigitalBase :: Integer -> Integer -> Bool

pandigitalBase b n = [0..b-1] `esSubconjunto` enBase b n

-- (enBase b n) es la lista de los dígitos de n en base b. Por ejemplo,

-- enBase 4 75 == [3,2,0,1]

-- enBase 4 76 == [0,3,0,1]

enBase :: Integer -> Integer -> [Integer]

enBase b n | n < b = [n]

| otherwise = n `mod` b : enBase b (n `div` b)

-- (esSubconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- esSubconjunto [1,5] [5,2,1] == True

-- esSubconjunto [1,5] [5,2,3] == False

esSubconjunto :: Eq a => [a] -> [a] -> Bool

esSubconjunto xs ys = all (`elem` ys) xs

Ternas coprimas

PorJosé A. Alonso 26-diciembre-20162-enero-2017

Definir la lista

   ternasCoprimas :: [(Integer,Integer,Integer)]

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

cuyos elementos son ternas de primos relativos (a,b,c) tales que a < b y a + b = c. Por ejemplo,

   λ> take 7 ternasCoprimas
   [(1,2,3),(1,3,4),(2,3,5),(1,4,5),(3,4,7),(1,5,6),(2,5,7)]
   λ> ternasCoprimas !! 300000
   (830,993,1823)

λ> take 7 ternasCoprimas

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

λ> ternasCoprimas !! 300000

(830,993,1823)

Soluciones

ternasCoprimas :: [(Integer,Integer,Integer)]
ternasCoprimas =
  [(a,b,a+b) | b <- [1..]
             , a <- [1..b-1]
             , gcd a b == 1]

-- Nota: Si a y b son coprimos, entonces también lo son a con a+b y b
-- con a+b.

ternasCoprimas :: [(Integer,Integer,Integer)]

ternasCoprimas =

[(a,b,a+b) | b <- [1..]

, a <- [1..b-1]

, gcd a b == 1]

-- Nota: Si a y b son coprimos, entonces también lo son a con a+b y b

-- con a+b.

Ordenación por una fila

PorJosé A. Alonso 22-diciembre-201629-diciembre-2016

Las matrices se pueden representar por listas de lista. Por ejemplo, la matriz

|1 2 5|

|3 0 7|

|9 1 6|

|6 4 2|

se puede representar por

   ej :: [[Int]]
   ej = [[1,2,5],
         [3,0,7],
         [9,1,6],
         [6,4,2]]

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

Definir la función

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

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

tal que (ordenaPorFila xss k) es la matriz obtenida ordenando xs por los elementos de la fila k. Por ejemplo,

   ordenaPorFila ej 1  ==  [[2,1,5],[0,3,7],[1,9,6],[4,6,2]]
   ordenaPorFila ej 2  ==  [[2,5,1],[0,7,3],[1,6,9],[4,2,6]]
   ordenaPorFila ej 3  ==  [[5,2,1],[7,0,3],[6,1,9],[2,4,6]]

ordenaPorFila ej 1 == [[2,1,5],[0,3,7],[1,9,6],[4,6,2]]

ordenaPorFila ej 2 == [[2,5,1],[0,7,3],[1,6,9],[4,2,6]]

ordenaPorFila ej 3 == [[5,2,1],[7,0,3],[6,1,9],[2,4,6]]

Soluciones

import Data.List (sort, transpose)

ej :: [[Int]]
ej = [[1,2,5],
      [3,0,7],
      [9,1,6],
      [6,4,2]]

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

ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorFila xss k =
  transpose (ordenaPorColumna (transpose xss) k)

ordenaPorColumna :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorColumna xss k =
  map snd (sort [(xs!!k,xs) | xs <- xss])

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

ordenaPorFila2 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorFila2 xss k =
  [[x | (_,x) <- sort $ zip (xss!!k) xs ] | xs <- xss]

import Data.List (sort, transpose)

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

-- 1ª solución

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

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

ordenaPorFila xss k =

transpose (ordenaPorColumna (transpose xss) k)

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

ordenaPorColumna xss k =

map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª solución

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

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

ordenaPorFila2 xss k =

[[x | (_,x) <- sort $ zip (xss!!k) xs ] | xs <- xss]

Día de la semana

PorJosé A. Alonso 21-diciembre-201628-diciembre-2016

Definir la función

   dia :: Int -> Int -> Int -> String

1	dia :: Int -> Int -> Int -> String

tal que (dia d m a) es el día de la semana correspondiente al día d del mes m del año a. Por ejemplo,

   dia 21 12 2016  ==  "Miercoles"
   dia 14  4 1936  ==  "Martes"

1 2	dia 21 12 2016 == "Miercoles" dia 14 4 1936 == "Martes"

Nota: Este ejercicio ha sido propuesto por Miguel Ibáñez.

Soluciones

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

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]
dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),
        ("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]
dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),
        (7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]
busca x xs p  =  [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int
diaAno (d,m,a)  =  d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String
dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']
  where  n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7
         x | d <= 29 && m <= 2  =  div (a - 2007) 4 - 1
           | otherwise          =  div (a - 2007) 4


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

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String
dia2 d m a = diasSemana !! h
  where m1 = if   (m < 3)
             then m + 12
             else m

        a1 = if   (m1 > 12)
             then a - 1
             else a

        k  = a1 `mod` 100
        j  = a1 `div` 100

        h  = ( d
             + ((13 * (m1 + 1)) `div` 5)
             + k
             + (k `div` 4)
             + (j `div` 4)
             - (2 * j)
             ) `mod` 7

diasSemana :: [String]
diasSemana = [ "Sabado" 
             , "Domingo"
             , "Lunes" 
             , "Martes"
             , "Miercoles"
             , "Jueves"
             , "Viernes"]

-- 1ª solución

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

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]

dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),

("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]

dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),

(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]

busca x xs p = [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int

diaAno (d,m,a) = d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String

dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']

where n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7

x | d <= 29 && m <= 2 = div (a - 2007) 4 - 1

| otherwise = div (a - 2007) 4

-- 2ª solución

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

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String

dia2 d m a = diasSemana !! h

where m1 = if (m < 3)

then m + 12

else m

a1 = if (m1 > 12)

then a - 1

else a

k = a1 `mod` 100

j = a1 `div` 100

h = ( d

+ ((13 * (m1 + 1)) `div` 5)

+ k

+ (k `div` 4)

+ (j `div` 4)

- (2 * j)

) `mod` 7

diasSemana :: [String]

diasSemana = [ "Sabado"

, "Domingo"

, "Lunes"

, "Martes"

, "Miercoles"

, "Jueves"

, "Viernes"]

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico