map – Página 3 – Exercitium

Números en una cadena

PorJosé A. Alonso 8-abril-201923-abril-2019

Definir la función

   numeros :: String -> [Int]

1	numeros :: String -> [Int]

tal que (numeros cs) es la lista de los números enteros no negativos de la cadena cs. Por ejemplo,

   λ> numeros "Esta cadena tiene 3 numeros: el 16 y el 2019 solamente." 
   [3,16,2019]
   λ> numeros "Esta cadena tiene 3 numeros naturales: -2 más 2 es 0" 
   [3,2,0]
   λ> numeros "Esta cadena tiene 1 numero natural: 2.5 no es entereo" 
   [1]

λ> numeros "Esta cadena tiene 3 numeros: el 16 y el 2019 solamente."

[3,16,2019]

λ> numeros "Esta cadena tiene 3 numeros naturales: -2 más 2 es 0"

[3,2,0]

λ> numeros "Esta cadena tiene 1 numero natural: 2.5 no es entereo"

[1]

Soluciones

import Data.Char  (isDigit)

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

numeros :: String -> [Int]
numeros cs = map read (filter esNumero (words cs))

-- (esNumero cs) se verifica si la cadena no vacía cs representa
-- un número entero. Por ejemplo,
--    esNumero "2019"  ==  True
--    esNumero "20.9"  ==  False
--    esNumero "201a"  ==  False
esNumero :: String -> Bool
esNumero = all (`elem` ['0'..'9'])

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

numeros2 :: String -> [Int]
numeros2 cs = map read (filter (all isDigit) (words cs))

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

numeros3 :: String -> [Int]
numeros3 = map read . filter (all isDigit) . words

import Data.Char (isDigit)

-- 1ª definición

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

numeros :: String -> [Int]

numeros cs = map read (filter esNumero (words cs))

-- (esNumero cs) se verifica si la cadena no vacía cs representa

-- un número entero. Por ejemplo,

-- esNumero "2019" == True

-- esNumero "20.9" == False

-- esNumero "201a" == False

esNumero :: String -> Bool

esNumero = all (`elem` ['0'..'9'])

-- 2ª solución

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

numeros2 :: String -> [Int]

numeros2 cs = map read (filter (all isDigit) (words cs))

-- 3ª solución

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

numeros3 :: String -> [Int]

numeros3 = map read . filter (all isDigit) . words

Pensamiento

Tu profecía, poeta.
— Mañana hablarán los mudos:
el corazón y la piedra.

Antonio Machado

Huecos de Aquiles

PorJosé A. Alonso 2-abril-201926-marzo-2022

Un número de Aquiles es un número natural n que es potente (es decir, si p es un divisor primo de n, entonces p² también lo es) y no es una potencia perfecta (es decir, no existen números naturales m y k tales que n es igual a m^k). Por ejemplo,

108 es un número de Aquiles proque es un número potente (ya que su factorización es 2^2 · 3^3, sus divisores primos son 2 and 3 y sus cuadrados (2^2 = 4 y 3^2 = 9) son divisores de 108. Además, 108 no es una potencia perfecta.
360 no es un número de Aquiles ya que 5 es un divisor primo de 360, pero 5^2 = 15 no lo es.
784 no es un número de Aquiles porque, aunque es potente, es una potencia perfecta ya que 784 = 28^2.

Los primeros números de Aquiles son

   72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, ...

1	72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, ...

Definir las funciones

   esAquiles              :: Integer -> Bool
   huecosDeAquiles        :: [Integer]
   graficaHuecosDeAquiles :: Int -> IO ()

esAquiles :: Integer -> Bool

huecosDeAquiles :: [Integer]

graficaHuecosDeAquiles :: Int -> IO ()

tales que

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

     esAquiles 108         ==  True
     esAquiles 360         ==  False
     esAquiles 784         ==  False
     esAquiles 5425069447  ==  True
     esAquiles 5425069448  ==  True

esAquiles 108 == True

esAquiles 360 == False

esAquiles 784 == False

esAquiles 5425069447 == True

esAquiles 5425069448 == True

huecosDeAquiles es la sucesión de la diferencias entre los números de Aquiles consecutivos. Por ejemplo,

     λ> take 15 huecosDeAquiles
     [36,92,88,104,40,68,148,27,125,64,104,4,153,27,171]

1 2	λ> take 15 huecosDeAquiles [36,92,88,104,40,68,148,27,125,64,104,4,153,27,171]

(graficaHuecosDeAquiles n) dibuja la gráfica de los n primeros huecos de Aquiles. Por ejemplo, (graficaHuecosDeAquiles 160) dibuja

Soluciones

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

-- Definición de esAquiles
-- =======================

esAquiles :: Integer -> Bool
esAquiles x = esPotente x && noEsPotenciaPerfecta x

-- (esPotente x) se verifica si x es potente. Por ejemplo,
--    esPotente 108  ==  True
--    esPotente 360  ==  False
--    esPotente 784  ==  True
esPotente :: Integer -> Bool
esPotente x = all (>1) (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorización de
-- x. Por ejemplo,
--    exponentes 108  ==  [2,3]
--    exponentes 360  ==  [3,2,1]
--    exponentes 784  ==  [4,2]
exponentes :: Integer -> [Int]
exponentes x = map length (group (primeFactors x))

-- (noEsPotenciaPerfecta x) se verifica si x no es una potencia
-- perfecta. Por ejemplo,
--    noEsPotenciaPerfecta 108  ==  True
--    noEsPotenciaPerfecta 360  ==  True
--    noEsPotenciaPerfecta 784  ==  False
noEsPotenciaPerfecta :: Integer -> Bool
noEsPotenciaPerfecta x = foldl1 gcd (exponentes x) == 1 

-- Definición de huecosDeAquiles
-- =============================

huecosDeAquiles :: [Integer]
huecosDeAquiles = zipWith (-) (tail aquiles) aquiles

-- aquiles es la sucesión de los números de Aquiles. Por ejemplo, 
--    λ> take 15 aquiles
--    [72,108,200,288,392,432,500,648,675,800,864,968,972,1125,1152]
aquiles :: [Integer]
aquiles = filter esAquiles [2..]

-- Definición de graficaHuecosDeAquiles
-- ====================================

graficaHuecosDeAquiles :: Int -> IO ()
graficaHuecosDeAquiles n =
  plotList [ Key Nothing
           , PNG "Huecos_de_Aquiles.png"
           ]
           (take n huecosDeAquiles)

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- Definición de esAquiles

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

esAquiles :: Integer -> Bool

esAquiles x = esPotente x && noEsPotenciaPerfecta x

-- (esPotente x) se verifica si x es potente. Por ejemplo,

-- esPotente 108 == True

-- esPotente 360 == False

-- esPotente 784 == True

esPotente :: Integer -> Bool

esPotente x = all (>1) (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorización de

-- x. Por ejemplo,

-- exponentes 108 == [2,3]

-- exponentes 360 == [3,2,1]

-- exponentes 784 == [4,2]

exponentes :: Integer -> [Int]

exponentes x = map length (group (primeFactors x))

-- (noEsPotenciaPerfecta x) se verifica si x no es una potencia

-- perfecta. Por ejemplo,

-- noEsPotenciaPerfecta 108 == True

-- noEsPotenciaPerfecta 360 == True

-- noEsPotenciaPerfecta 784 == False

noEsPotenciaPerfecta :: Integer -> Bool

noEsPotenciaPerfecta x = foldl1 gcd (exponentes x) == 1

-- Definición de huecosDeAquiles

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

huecosDeAquiles :: [Integer]

huecosDeAquiles = zipWith (-) (tail aquiles) aquiles

-- aquiles es la sucesión de los números de Aquiles. Por ejemplo,

-- λ> take 15 aquiles

-- [72,108,200,288,392,432,500,648,675,800,864,968,972,1125,1152]

aquiles :: [Integer]

aquiles = filter esAquiles [2..]

-- Definición de graficaHuecosDeAquiles

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

graficaHuecosDeAquiles :: Int -> IO ()

graficaHuecosDeAquiles n =

plotList [ Key Nothing

, PNG "Huecos_de_Aquiles.png"

]

(take n huecosDeAquiles)

Pensamiento

Tengo a mis amigos
en mi soledad;
cuando estoy con ellos
¡qué lejos están!

Antonio Machado

Triángulo de Euler

PorJosé A. Alonso 29-marzo-20195-abril-2019

El triángulo de Euler se construye a partir de las siguientes relaciones

   A(n,1) = A(n,n) = 1
   A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

1 2	A(n,1) = A(n,n) = 1 A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

Sus primeros términos son

   1 
   1 1                                                       
   1 4   1                                            
   1 11  11    1                                    
   1 26  66    26    1                             
   1 57  302   302   57     1                    
   1 120 1191  2416  1191   120   1            
   1 247 4293  15619 15619  4293  247   1   
   1 502 14608 88234 156190 88234 14608 502 1

1 1

1 4 1

1 11 11 1

1 26 66 26 1

1 57 302 302 57 1

1 120 1191 2416 1191 120 1

1 247 4293 15619 15619 4293 247 1

1 502 14608 88234 156190 88234 14608 502 1

Definir las siguientes funciones:

  numeroEuler        :: Integer -> Integer -> Integer
  filaTrianguloEuler :: Integer -> [Integer]
  trianguloEuler     :: [[Integer]]

numeroEuler :: Integer -> Integer -> Integer

filaTrianguloEuler :: Integer -> [Integer]

trianguloEuler :: [[Integer]]

tales que

(numeroEuler n k) es el número de Euler A(n,k). Por ejemplo,

     numeroEuler 8 3  == 15619
     numeroEuler 20 6 == 21598596303099900
     length (show (numeroEuler 1000 500)) == 2567

numeroEuler 8 3 == 15619

numeroEuler 20 6 == 21598596303099900

length (show (numeroEuler 1000 500)) == 2567

(filaTrianguloEuler n) es la n-ésima fila del triángulo de Euler. Por ejemplo,

     filaTrianguloEuler 7  ==  [1,120,1191,2416,1191,120,1]
     filaTrianguloEuler 8  ==  [1,247,4293,15619,15619,4293,247,1]
     length (show (maximum (filaTrianguloEuler 1000)))  ==  2567

filaTrianguloEuler 7 == [1,120,1191,2416,1191,120,1]

filaTrianguloEuler 8 == [1,247,4293,15619,15619,4293,247,1]

length (show (maximum (filaTrianguloEuler 1000))) == 2567

trianguloEuler es la lista con las filas del triángulo de Euler

     λ> take 6 trianguloEuler
     [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
     λ> length (show (maximum (trianguloEuler !! 999)))
     2567

λ> take 6 trianguloEuler

[[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]

λ> length (show (maximum (trianguloEuler !! 999)))

2567

Soluciones

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

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

trianguloEuler :: [[Integer]]
trianguloEuler = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente a la xs en el triángulo de
-- Euler. Por ejemplo,
--    λ> siguiente [1]
--    [1,1]
--    λ> siguiente it
--    [1,4,1]
--    λ> siguiente it
--    [1,11,11,1]
siguiente :: [Integer] -> [Integer]
siguiente xs = zipWith (+) us vs
  where n = genericLength xs
        us = zipWith (*) (0:xs) [n+1,n..1]
        vs = zipWith (*) (xs++[0]) [1..n+1]

filaTrianguloEuler :: Integer -> [Integer]
filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)

numeroEuler :: Integer -> Integer -> Integer
numeroEuler n k = filaTrianguloEuler n `genericIndex` k

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

numeroEuler2 :: Integer -> Integer -> Integer
numeroEuler2 n 0 = 1
numeroEuler2 n m 
  | n == m    = 0
  | otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m

filaTrianguloEuler2 :: Integer -> [Integer]
filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]

trianguloEuler2 :: [[Integer]]
trianguloEuler2 = map filaTrianguloEuler2 [1..]
                  
-- 3ª solución
-- ===========

numeroEuler3 :: Integer -> Integer -> Integer
numeroEuler3 n k = (matrizEuler n k) ! (n,k)

-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada
-- por los números de Euler. Por ejemplo,
--   λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]
--   [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
matrizEuler :: Integer -> Integer -> Array (Integer,Integer) Integer
matrizEuler n m = q
  where q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
        f i 0 = 1
        f i j
          | i == j    = 0
          | otherwise = (i-j) * q!(i-1,j-1) + (j+1)* q!(i-1,j)

filaTrianguloEuler3 :: Integer -> [Integer]
filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]

trianguloEuler3 :: [[Integer]]
trianguloEuler3 = map filaTrianguloEuler3 [1..]

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

-- La comparación es
--   λ> numeroEuler 22 11
--   301958232385734088196
--   (0.01 secs, 118,760 bytes)
--   λ> numeroEuler2 22 11
--   301958232385734088196
--   (3.96 secs, 524,955,384 bytes)
--   λ> numeroEuler3 22 11
--   301958232385734088196
--   (0.01 secs, 356,296 bytes)
--   
--   λ> length (show (numeroEuler 800 400))
--   1976
--   (0.01 secs, 383,080 bytes)
--   λ> length (show (numeroEuler3 800 400))
--   1976
--   (2.13 secs, 508,780,696 bytes)

import Data.List (genericLength, genericIndex)

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

-- 1ª solución

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

trianguloEuler :: [[Integer]]

trianguloEuler = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente a la xs en el triángulo de

-- Euler. Por ejemplo,

-- λ> siguiente [1]

-- [1,1]

-- λ> siguiente it

-- [1,4,1]

-- λ> siguiente it

-- [1,11,11,1]

siguiente :: [Integer] -> [Integer]

siguiente xs = zipWith (+) us vs

where n = genericLength xs

us = zipWith (*) (0:xs) [n+1,n..1]

vs = zipWith (*) (xs++[0]) [1..n+1]

filaTrianguloEuler :: Integer -> [Integer]

filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)

numeroEuler :: Integer -> Integer -> Integer

numeroEuler n k = filaTrianguloEuler n `genericIndex` k

-- 2ª solución

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

numeroEuler2 :: Integer -> Integer -> Integer

numeroEuler2 n 0 = 1

numeroEuler2 n m

| n == m = 0

| otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m

filaTrianguloEuler2 :: Integer -> [Integer]

filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]

trianguloEuler2 :: [[Integer]]

trianguloEuler2 = map filaTrianguloEuler2 [1..]

-- 3ª solución

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

numeroEuler3 :: Integer -> Integer -> Integer

numeroEuler3 n k = (matrizEuler n k) ! (n,k)

-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada

-- por los números de Euler. Por ejemplo,

-- λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]

-- [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]

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

matrizEuler n m = q

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

f i 0 = 1

f i j

| i == j = 0

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

filaTrianguloEuler3 :: Integer -> [Integer]

filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]

trianguloEuler3 :: [[Integer]]

trianguloEuler3 = map filaTrianguloEuler3 [1..]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroEuler 22 11

-- 301958232385734088196

-- (0.01 secs, 118,760 bytes)

-- λ> numeroEuler2 22 11

-- 301958232385734088196

-- (3.96 secs, 524,955,384 bytes)

-- λ> numeroEuler3 22 11

-- 301958232385734088196

-- (0.01 secs, 356,296 bytes)

-- λ> length (show (numeroEuler 800 400))

-- 1976

-- (0.01 secs, 383,080 bytes)

-- λ> length (show (numeroEuler3 800 400))

-- 1976

-- (2.13 secs, 508,780,696 bytes)

Pensamiento

Señor San Jerónimo,
suelte usted la piedra
con que se machaca.
Me pegó con ella.

Antonio Machado

Subconjuntos divisibles

PorJosé A. Alonso 28-marzo-20194-abril-2019

Definir la función

  subconjuntosDivisibles :: [Int] -> [[Int]]

1	subconjuntosDivisibles :: [Int] -> [[Int]]

tal que (subconjuntosDivisibles xs) es la lista de todos los subconjuntos de xs en los que todos los elementos tienen un factor común mayor que 1. Por ejemplo,

  subconjuntosDivisibles []         ==  [[]]
  subconjuntosDivisibles [1]        ==  [[]]
  subconjuntosDivisibles [3]        ==  [[3],[]]
  subconjuntosDivisibles [1,3]      ==  [[3],[]]
  subconjuntosDivisibles [3,6]      ==  [[3,6],[3],[6],[]]
  subconjuntosDivisibles [1,3,6]    ==  [[3,6],[3],[6],[]]
  subconjuntosDivisibles [2,3,6]    ==  [[2,6],[2],[3,6],[3],[6],[]]
  subconjuntosDivisibles [2,3,6,8]  ==  [[2,6,8],[2,6],[2,8],[2],[3,6],[3],[6,8],[6],[8],[]]
  length (subconjuntosDivisibles [1..10])  ==  41
  length (subconjuntosDivisibles [1..20])  ==  1097
  length (subconjuntosDivisibles [1..30])  ==  33833
  length (subconjuntosDivisibles [1..40])  ==  1056986

subconjuntosDivisibles [] == [[]]

subconjuntosDivisibles [1] == [[]]

subconjuntosDivisibles [3] == [[3],[]]

subconjuntosDivisibles [1,3] == [[3],[]]

subconjuntosDivisibles [3,6] == [[3,6],[3],[6],[]]

subconjuntosDivisibles [1,3,6] == [[3,6],[3],[6],[]]

subconjuntosDivisibles [2,3,6] == [[2,6],[2],[3,6],[3],[6],[]]

subconjuntosDivisibles [2,3,6,8] == [[2,6,8],[2,6],[2,8],[2],[3,6],[3],[6,8],[6],[8],[]]

length (subconjuntosDivisibles [1..10]) == 41

length (subconjuntosDivisibles [1..20]) == 1097

length (subconjuntosDivisibles [1..30]) == 33833

length (subconjuntosDivisibles [1..40]) == 1056986

Soluciones

import Data.List (foldl1', subsequences)

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

subconjuntosDivisibles :: [Int] -> [[Int]]
subconjuntosDivisibles xs = filter esDivisible (subsequences xs)

-- (esDivisible xs) se verifica si todos los elementos de xs tienen un
-- factor común mayor que 1. Por ejemplo,
--    esDivisible [6,10,22]  ==  True
--    esDivisible [6,10,23]  ==  False
esDivisible :: [Int] -> Bool
esDivisible [] = True
esDivisible xs = mcd xs > 1

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [6,10,22]  ==  2
--    mcd [6,10,23]  ==  1
mcd :: [Int] -> Int
mcd = foldl1' gcd

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

subconjuntosDivisibles2 :: [Int] -> [[Int]]
subconjuntosDivisibles2 []     = [[]]
subconjuntosDivisibles2 (x:xs) = [x:ys | ys <- yss, esDivisible (x:ys)] ++ yss
  where yss = subconjuntosDivisibles2 xs

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

subconjuntosDivisibles3 :: [Int] -> [[Int]]
subconjuntosDivisibles3 []     = [[]]
subconjuntosDivisibles3 (x:xs) = filter esDivisible (map (x:) yss) ++ yss
  where yss = subconjuntosDivisibles3 xs

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

-- La comparación es
--    λ> length (subconjuntosDivisibles [1..21])
--    1164
--    (3.83 secs, 5,750,416,768 bytes)
--    λ> length (subconjuntosDivisibles2 [1..21])
--    1164
--    (0.01 secs, 5,400,232 bytes)
--    λ> length (subconjuntosDivisibles3 [1..21])
--    1164
--    (0.01 secs, 5,264,928 bytes)
--    
--    λ> length (subconjuntosDivisibles2 [1..40])
--    1056986
--    (6.95 secs, 8,845,664,672 bytes)
--    λ> length (subconjuntosDivisibles3 [1..40])
--    1056986
--    (6.74 secs, 8,727,141,792 bytes)

import Data.List (foldl1', subsequences)

-- 1ª solución

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

subconjuntosDivisibles :: [Int] -> [[Int]]

subconjuntosDivisibles xs = filter esDivisible (subsequences xs)

-- (esDivisible xs) se verifica si todos los elementos de xs tienen un

-- factor común mayor que 1. Por ejemplo,

-- esDivisible [6,10,22] == True

-- esDivisible [6,10,23] == False

esDivisible :: [Int] -> Bool

esDivisible [] = True

esDivisible xs = mcd xs > 1

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,

-- mcd [6,10,22] == 2

-- mcd [6,10,23] == 1

mcd :: [Int] -> Int

mcd = foldl1' gcd

-- 2ª solución

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

subconjuntosDivisibles2 :: [Int] -> [[Int]]

subconjuntosDivisibles2 [] = [[]]

subconjuntosDivisibles2 (x:xs) = [x:ys | ys <- yss, esDivisible (x:ys)] ++ yss

where yss = subconjuntosDivisibles2 xs

-- 3ª solución

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

subconjuntosDivisibles3 :: [Int] -> [[Int]]

subconjuntosDivisibles3 [] = [[]]

subconjuntosDivisibles3 (x:xs) = filter esDivisible (map (x:) yss) ++ yss

where yss = subconjuntosDivisibles3 xs

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (subconjuntosDivisibles [1..21])

-- 1164

-- (3.83 secs, 5,750,416,768 bytes)

-- λ> length (subconjuntosDivisibles2 [1..21])

-- 1164

-- (0.01 secs, 5,400,232 bytes)

-- λ> length (subconjuntosDivisibles3 [1..21])

-- 1164

-- (0.01 secs, 5,264,928 bytes)

-- λ> length (subconjuntosDivisibles2 [1..40])

-- 1056986

-- (6.95 secs, 8,845,664,672 bytes)

-- λ> length (subconjuntosDivisibles3 [1..40])

-- 1056986

-- (6.74 secs, 8,727,141,792 bytes)

Pensamiento

Abejas, cantores,
no a la miel, sino a las flores.

Antonio Machado

Matriz girada 180 grados

PorJosé A. Alonso 27-marzo-20193-abril-2019

Definir la función

   matrizGirada180 :: Matrix a -> Matrix a

1	matrizGirada180 :: Matrix a -> Matrix a

tal que (matrizGirada180 p) es la matriz obtenida girando 180 grados la matriz p. Por ejemplo,

   λ> fromList 4 3 [1..]
   (  1  2  3 )
   (  4  5  6 )
   (  7  8  9 )
   ( 10 11 12 )

   λ> matrizGirada180 (fromList 4 3 [1..])
   ( 12 11 10 )
   (  9  8  7 )
   (  6  5  4 )
   (  3  2  1 )

   λ> fromList 3 4 [1..]
   (  1  2  3  4 )
   (  5  6  7  8 )
   (  9 10 11 12 )

   λ> matrizGirada180 (fromList 3 4 [1..])
   ( 12 11 10  9 )
   (  8  7  6  5 )
   (  4  3  2  1 )

λ> fromList 4 3 [1..]

( 1 2 3 )

( 4 5 6 )

( 7 8 9 )

( 10 11 12 )

λ> matrizGirada180 (fromList 4 3 [1..])

( 12 11 10 )

( 9 8 7 )

( 6 5 4 )

( 3 2 1 )

λ> fromList 3 4 [1..]

( 1 2 3 4 )

( 5 6 7 8 )

( 9 10 11 12 )

λ> matrizGirada180 (fromList 3 4 [1..])

( 12 11 10 9 )

( 8 7 6 5 )

( 4 3 2 1 )

Soluciones

import Data.Matrix ( Matrix
                   , (!)
                   , fromList
                   , fromLists
                   , matrix
                   , ncols
                   , nrows
                   , toLists
                   )

-- 1ª solución
matrizGirada180 :: Matrix a -> Matrix a
matrizGirada180 p = matrix m n f
  where m       = nrows p
        n       = ncols p
        f (i,j) = p!(m-i+1,n-j+1)

-- 2ª solución
matrizGirada180b :: Matrix a -> Matrix a
matrizGirada180b p =
  fromLists (reverse (map reverse (toLists p)))

-- 3ª solución
matrizGirada180c :: Matrix a -> Matrix a
matrizGirada180c =
  fromLists . reverse . map reverse . toLists

import Data.Matrix ( Matrix

, (!)

, fromList

, fromLists

, matrix

, ncols

, nrows

, toLists

)

-- 1ª solución

matrizGirada180 :: Matrix a -> Matrix a

matrizGirada180 p = matrix m n f

where m = nrows p

n = ncols p

f (i,j) = p!(m-i+1,n-j+1)

-- 2ª solución

matrizGirada180b :: Matrix a -> Matrix a

matrizGirada180b p =

fromLists (reverse (map reverse (toLists p)))

-- 3ª solución

matrizGirada180c :: Matrix a -> Matrix a

matrizGirada180c =

fromLists . reverse . map reverse . toLists

Pensamiento

Bueno es recordar
las palabras viejas
que han de volver a sonar.

Antonio Machado

Árboles cuyas ramas cumplen una propiedad

PorJosé A. Alonso 26-marzo-20192-abril-2019

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

   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
      / \         / \          /|\
     2   3      -2   3        / | \  
    / \          |          -2  7  3  
   4   5        -4          / \      
                           4   5

-1 1 1

/ \ / \ /|\

2 3 -2 3 / | \

/ \ | -2 7 3

4 5 -4 / \

4 5

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N (-2) [N (-4) []], N 3 []]
   ej3 = N 1 [N (-2) [N 4 [], N 5 []], N 7 [], N 3 []]

ej1, ej2, ej3 :: Arbol Int

ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N (-2) [N (-4) []], N 3 []]

ej3 = N 1 [N (-2) [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   todasDesdeAlguno :: (a -> Bool) -> Arbol a -> Bool

1	todasDesdeAlguno :: (a -> Bool) -> Arbol a -> Bool

tal que (todasDesdeAlguno p ar) se verifica si para toda rama existe un elemento a partir del cual todos los elementos de la rama verifican la propiedad p. Por ejemplo,

   todasDesdeAlguno (>0) ej1 == True
   todasDesdeAlguno (>0) ej2 == False
   todasDesdeAlguno (>0) ej3 == True

todasDesdeAlguno (>0) ej1 == True

todasDesdeAlguno (>0) ej2 == False

todasDesdeAlguno (>0) ej3 == True

Soluciones

import Data.List (tails)

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

ej1, ej2, ej3 :: Arbol Int
ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N (-2) [N (-4) []], N 3 []]
ej3 = N 1 [N (-2) [N 4 [], N 5 []], N 7 [], N 3 []]

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

todasDesdeAlguno :: (b -> Bool) -> Arbol b -> Bool
todasDesdeAlguno p a = all (desdeAlguno p) (ramas a)

-- (desdeAlguno p xs) se verifica si la propiedad xs tiene un elementemo
-- a partir del cual todos los siguientes cumplen la propiedad p. Por
-- ejemplo, 
--    desdeAlguno (>0) [-1,2,4]   ==  True
--    desdeAlguno (>0) [1,-2,-4]  ==  False
--    desdeAlguno (>0) [1,-2,4]   ==  True

-- 1ª definición de desdeAlguno
desdeAlguno1 :: (a -> Bool) -> [a] -> Bool
desdeAlguno1 p xs =
  not (null (takeWhile p (reverse xs)))

-- 2ª definición de desdeAlguno
desdeAlguno2 :: (a -> Bool) -> [a] -> Bool
desdeAlguno2 p xs = any (all p) (init (tails xs))

-- Comparación de eficiencia:
--    λ> desdeAlguno1 (>10^7) [1..1+10^7]
--    True
--    (4.36 secs, 960,101,896 bytes)
--    λ> desdeAlguno2 (>10^7) [1..1+10^7]
--    True
--    (5.62 secs, 3,600,101,424 bytes)

-- Usaremos la 1ª definición de desdeAlguno
desdeAlguno :: (a -> Bool) -> [a] -> Bool
desdeAlguno = desdeAlguno1

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

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

todasDesdeAlguno2 :: (b -> Bool) -> Arbol b -> Bool
todasDesdeAlguno2 p (N x []) = p x
todasDesdeAlguno2 p (N _ as) = all (todasDesdeAlguno2 p) as

import Data.List (tails)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N (-2) [N (-4) []], N 3 []]

ej3 = N 1 [N (-2) [N 4 [], N 5 []], N 7 [], N 3 []]

-- 1ª solución

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

todasDesdeAlguno :: (b -> Bool) -> Arbol b -> Bool

todasDesdeAlguno p a = all (desdeAlguno p) (ramas a)

-- (desdeAlguno p xs) se verifica si la propiedad xs tiene un elementemo

-- a partir del cual todos los siguientes cumplen la propiedad p. Por

-- ejemplo,

-- desdeAlguno (>0) [-1,2,4] == True

-- desdeAlguno (>0) [1,-2,-4] == False

-- desdeAlguno (>0) [1,-2,4] == True

-- 1ª definición de desdeAlguno

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

desdeAlguno1 p xs =

not (null (takeWhile p (reverse xs)))

-- 2ª definición de desdeAlguno

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

desdeAlguno2 p xs = any (all p) (init (tails xs))

-- Comparación de eficiencia:

-- λ> desdeAlguno1 (>10^7) [1..1+10^7]

-- True

-- (4.36 secs, 960,101,896 bytes)

-- λ> desdeAlguno2 (>10^7) [1..1+10^7]

-- True

-- (5.62 secs, 3,600,101,424 bytes)

-- Usaremos la 1ª definición de desdeAlguno

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

desdeAlguno = desdeAlguno1

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

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

-- ramas ej2 == [[1,-2,-4],[1,3]]

-- ramas ej3 == [[1,-2,4],[1,-2,5],[1,7],[1,3]]

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

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

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

-- 2ª solución

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

todasDesdeAlguno2 :: (b -> Bool) -> Arbol b -> Bool

todasDesdeAlguno2 p (N x []) = p x

todasDesdeAlguno2 p (N _ as) = all (todasDesdeAlguno2 p) as

Pensamiento

Por dar al viento trabajo,
cosía con hilo doble
las hojas secas del árbol.

Antonio Machado

Caminos minimales en un árbol numérico

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

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

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

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

Se pueden definir árboles. Por ejemplo,

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

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

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

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

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

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

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

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

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

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

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

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

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

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

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

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

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

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

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

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

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

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

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

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

λ> caminosMinimales 50

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

Soluciones

import Data.Tree
import Test.QuickCheck

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

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

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

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

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

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

import Data.Tree

import Test.QuickCheck

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

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

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

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

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

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

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

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

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

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

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

where yss = caminos x

m = minimum (map length yss)

Pensamiento

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

Antonio Machado

Cambio con el menor número de monedas

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

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

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

1, 1, 1, 1, 1, 1

1, 1, 1, 3

1, 1, 4

3, 3

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

Definir

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

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

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

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

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

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

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

Soluciones

import Data.Array ((!), array)

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

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

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

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

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

infinito :: Int
infinito = 10^30

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

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

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

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

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

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

import Data.Array ((!), array)

-- 1ª solución

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

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

monedas ms x

| null cs = Nothing

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

where cs = cambios ms x

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

-- de ms. Por ejemplo,

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

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

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

-- []

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

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

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

cambios _ 0 = [[]]

cambios [] _ = []

cambios (k:ks) m

| m < k = []

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

cambios ks m

-- 2ª solución

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

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

monedas2 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = aux n

aux 0 = 0

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

infinito :: Int

infinito = 10^30

minimo :: [Int] -> Int

minimo [] = infinito

minimo xs = minimum xs

siguiente :: Int -> Int

siguiente x | x == infinito = infinito

| otherwise = 1 + x

-- 3ª solución

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

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

monedas3 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = v ! n

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

f 0 = 0

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

-- Comparación de eficiencia

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

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

-- Just 3

-- (0.02 secs, 871,144 bytes)

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

-- Just 3

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

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

-- Just 3

-- (0.01 secs, 157,232 bytes)

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

-- Just 7

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

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

-- Just 7

-- (0.01 secs, 623,376 bytes)

Pensamiento

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

Antonio Machado

Máxima longitud de sublistas crecientes

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

Definir la función

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

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

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

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

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

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

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

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

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

λ> longitudMayorSublistaCreciente2 xs

λ> longitudMayorSublistaCreciente3 xs

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

import Data.List (nub, sort)

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

-- 1ª solución

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

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

longitudMayorSublistaCreciente1 =

length . head . mayoresCrecientes

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

-- de mayor longitud. Por ejemplo,

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

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

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

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

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

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

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

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

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

mayoresCrecientes xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

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

-- xs. Por ejemplo,

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

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

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

sublistasCrecientes [] = [[]]

sublistasCrecientes (x:xs) =

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

where yss = sublistasCrecientes xs

-- 2ª solución

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

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

longitudMayorSublistaCreciente2 xs =

longitudSCM xs (sort (nub xs))

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

-- ys. Por ejemplo,

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

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

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

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

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

where n = length xs

m = length ys

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

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

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

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

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

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

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

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

-- Gráficamente,

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

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

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

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

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

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

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

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

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

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

matrizLongitudSCM xs ys = q

where

n = length xs

m = length ys

v = listArray (1,n) xs

w = listArray (1,m) ys

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

where f 0 _ = 0

f _ 0 = 0

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

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

-- 3ª solución

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

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

longitudMayorSublistaCreciente3 xs =

maximum (elems (vectorlongitudMayorSublistaCreciente xs))

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

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

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

-- xs. Por ejemplo,

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

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

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

vectorlongitudMayorSublistaCreciente xs = v

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

n = length xs

w = listArray (1,n) xs

f 1 = 1

f i | null ls = 1

| otherwise = 1 + maximum ls

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

-- Comparación de eficiencia

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

-- λ> longitudMayorSublistaCreciente1 [1..20]

-- 20

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

-- λ> longitudMayorSublistaCreciente2 [1..20]

-- 20

-- (0.03 secs, 361,384 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..20]

-- 20

-- (0.03 secs, 253,944 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..2000]

-- 2000

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

-- λ> longitudMayorSublistaCreciente3 [1..2000]

-- 2000

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

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

-- 1

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

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

-- 1

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

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

-- 1

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

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

-- 10

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

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

-- 10

-- (0.04 secs, 899,152 bytes)

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

-- 10

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

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

-- 10

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

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

-- 10

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

-- λ> import System.Random

-- (0.00 secs, 0 bytes)

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

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

-- λ> longitudMayorSublistaCreciente2 xs

-- 61

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

-- λ> longitudMayorSublistaCreciente3 xs

-- 61

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

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

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

-- λ> longitudMayorSublistaCreciente2 xs

-- 57

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

-- λ> longitudMayorSublistaCreciente3 xs

-- 57

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

Pensamiento

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

Antonio Machado

Camino de máxima suma en una matriz

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

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

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

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

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

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

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

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

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

1	caminoMaxSuma :: Matrix Int -> [Int]

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

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

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

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

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

766721999

Soluciones

import Data.Matrix
import Test.QuickCheck

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

import Data.Matrix

import Test.QuickCheck

-- 1ª definición

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

caminoMaxSuma1 :: Matrix Int -> [Int]

caminoMaxSuma1 m =

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

where cs = caminos1 m

k = maximum (map sum cs)

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

caminos1 m =

map reverse (caminos1Aux m (nf,nc))

where nf = nrows m

nc = ncols m

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

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

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

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

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

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

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

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

caminos1Aux m (i-1,j)]

-- 2ª definición

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

caminoMaxSuma2 :: Matrix Int -> [Int]

caminoMaxSuma2 m =

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

where cs = caminos2 m

k = maximum (map sum cs)

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

caminos2 m =

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

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

matrizCaminos m = q

where

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

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

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

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

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

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

caminoMaxSuma3 :: Matrix Int -> [Int]

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

where nf = nrows m

nc = ncols m

q = caminoMaxSumaAux m

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

caminoMaxSumaAux m = q

where

nf = nrows m

nc = ncols m

q = matrix nf nc f

where

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

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

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

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

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

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

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

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

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

-- Equivalencia de las definiciones

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

-- El generador es

instance Arbitrary a => Arbitrary (Matrix a) where

arbitrary = do

m <- choose (1,7)

n <- choose (1,7)

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

return (fromList m n xs)

-- Por ejemplo,

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

-- [( 0 )

-- ( 0 )

-- ,( 1 2 )

-- ( -1 1 )

-- ( -1 -2 )

-- ( 1 -1 )

-- ( 1 0 )

-- ( 2 0 )

-- ( 2 -2 )

-- ,( -4 4 -2 )

-- ( -2 0 -2 )

-- ( 0 -1 -2 )

-- ( -4 -1 2 )

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

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

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

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

-- ...

-- La propiedad es

prop_caminoMaxSuma :: Matrix Int -> Bool

prop_caminoMaxSuma m =

x1 == x2 && x2 == x3

where x1 = sum (caminoMaxSuma1 m)

x2 = sum (caminoMaxSuma2 m)

x3 = sum (caminoMaxSuma1 m)

-- La comprobación es

-- λ> quickCheck prop_caminoMaxSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

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

-- 21

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

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

-- 21

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

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

-- 21

-- (0.01 secs, 0 bytes)

Pensamiento

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

Antonio Machado

Números como suma de sus dígitos

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

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

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

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

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

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

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

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

Definir las funciones

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

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

tales que

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

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

minimoSumandosDigitos 23 == 8

minimoSumandosDigitos 232 == 78

minimoSumandosDigitos 2323 == 775

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

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

Soluciones

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

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

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

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

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

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

import Data.List (nub, genericLength, sort)

import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer

minimoSumandosDigitos n =

minimoSumandos (digitos n) n

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

-- digitos 2032 == [2,3]

digitos :: Integer -> [Integer]

digitos n =

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

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

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

-- ejemplo,

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

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

minimoSumandos xs n =

minimum (mapo genericLength (sumas xs n))

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

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

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

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

sumas [] 0 = [[]]

sumas [] _ = []

sumas (x:xs) n

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

| otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()

graficaMinimoSumandosDigitos n =

plotList [ Key Nothing

, PNG "Numero_como_suma_de_sus_digitos.png"

]

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

Pensamiento

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

Antonio Machado

Las torres de Hanói

PorJosé A. Alonso 5-marzo-201912-marzo-2019

Las torres de Hanoi es un rompecabeza que consta de tres postes que llamaremos A, B y C. Hay N discos de distintos tamaños en el poste A, de forma que no hay un disco situado sobre otro de menor tamaño. Los postes B y C están vacíos. Sólo puede moverse un disco a la vez y todos los discos deben de estar ensartados en algún poste. Ningún disco puede situarse sobre otro de menor tamaño. El problema consiste en colocar los N discos en el poste C.

Los postes se pueden representar mediante el siguiente tipo de datos

   data Poste = A | B | C
     deriving Show

1 2	data Poste = A \| B \| C deriving Show

Definir las funciones

   movimientos :: Integer -> [(Integer,Poste,Poste)]
   hanoi       :: Integer -> IO ()

1 2	movimientos :: Integer -> [(Integer,Poste,Poste)] hanoi :: Integer -> IO ()

tales que

(movimientos n) es la lista de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

     λ> movimientos 1
     [(1,A,C)]
     λ> movimientos 2
     [(1,A,B),(2,A,C),(1,B,C)]
     λ> movimientos 3
     [(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]

λ> movimientos 1

[(1,A,C)]

λ> movimientos 2

[(1,A,B),(2,A,C),(1,B,C)]

λ> movimientos 3

[(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]

(hanoi n) escribe los mensajes de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

     λ> hanoi 3
     Mueve el disco 1 de A a C
     Mueve el disco 2 de A a B
     Mueve el disco 1 de C a B
     Mueve el disco 3 de A a C
     Mueve el disco 1 de B a A
     Mueve el disco 2 de B a C
     Mueve el disco 1 de A a C

λ> hanoi 3

Mueve el disco 1 de A a C

Mueve el disco 2 de A a B

Mueve el disco 1 de C a B

Mueve el disco 3 de A a C

Mueve el disco 1 de B a A

Mueve el disco 2 de B a C

Mueve el disco 1 de A a C

Soluciones

data Poste = A | B | C
  deriving (Eq, Show)

movimientos :: Integer -> [(Integer,Poste,Poste)]
movimientos n = aux n A B C
  where  
    aux n a b c
      | n == 1    = [(1,a,c)]
      | otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c

hanoi :: Integer -> IO ()
hanoi n = 
  putStrLn (unlines (map mensaje (movimientos n)))

-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido
-- desde el poste x al poste y. Por ejemplo, 
--    λ> mensaje (1,A,B)
--    "Mueve el disco 1 de A a B"
mensaje :: (Integer,Poste,Poste) -> String
mensaje (n,x,y) =
  "Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

data Poste = A | B | C

deriving (Eq, Show)

movimientos :: Integer -> [(Integer,Poste,Poste)]

movimientos n = aux n A B C

where

aux n a b c

| n == 1 = [(1,a,c)]

| otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c

hanoi :: Integer -> IO ()

hanoi n =

putStrLn (unlines (map mensaje (movimientos n)))

-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido

-- desde el poste x al poste y. Por ejemplo,

-- λ> mensaje (1,A,B)

-- "Mueve el disco 1 de A a B"

mensaje :: (Integer,Poste,Poste) -> String

mensaje (n,x,y) =

"Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

Pensamiento

En preguntar lo que sabes
el tiempo no has de perder …
Y a preguntas sin respuesta
¿quién te podrá responder?

Antonio Machado

Hojas con caminos no decrecientes

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

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

   data Arbol = N Int [Arbol]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 6 /|\ /|\ |

/ \ / \ 4 2 6 4 5 6 2

4 5 5 7

se representan por

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

ej1, ej2, ej3 :: Arbol

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

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

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

1	hojasEnNoDecreciente :: Arbol -> [Int]

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

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

hojasEnNoDecreciente ej1 == [4,5,7]

hojasEnNoDecreciente ej2 == [4,6,8]

hojasEnNoDecreciente ej3 == []

Soluciones

import Data.List (sort, nub)

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

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

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

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

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

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

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

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

import Data.List (sort, nub)

data Arbol = N Int [Arbol]

deriving Show

ej1, ej2, ej3 :: Arbol

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

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

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

-- 1ª solución

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

hojasEnNoDecreciente :: Arbol -> [Int]

hojasEnNoDecreciente a =

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

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

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

-- ramasNoDecrecientes ej3 == []

ramasNoDecrecientes :: Arbol -> [[Int]]

ramasNoDecrecientes a =

filter esNoDecreciente (ramas a)

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

-- λ> ramas ej1

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

-- λ> ramas ej2

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

-- λ> ramas ej3

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

ramas :: Arbol -> [[Int]]

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

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

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

-- decreciente. Por ejemplo,

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

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

esNoDecreciente :: [Int] -> Bool

esNoDecreciente xs =

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

-- 2ª solución

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

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

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

-- hojasEnNoDecreciente ej3 == []

hojasEnNoDecreciente2 :: Arbol -> [Int]

hojasEnNoDecreciente2 = sort . nub . aux

where

aux (N x []) = [x]

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

Pensamiento

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

Antonio Machado

Número de descomposiciones en sumas de cuatro cuadrados

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

Definir la función

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

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

tales que

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

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

nDescomposiciones 4 == 1

nDescomposiciones 5 == 0

nDescomposiciones 7 == 4

nDescomposiciones 10 == 6

nDescomposiciones 15 == 12

nDescomposiciones 50000 == 5682

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

import Data.Array

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª solución

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

nDescomposiciones :: Int -> Int

nDescomposiciones = length . descomposiciones

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

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

-- λ> descomposiciones 4

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

-- λ> descomposiciones 5

-- []

-- λ> descomposiciones 7

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

-- λ> descomposiciones 10

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

-- λ> descomposiciones 15

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

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

descomposiciones :: Int -> [[Int]]

descomposiciones x = aux x 4

where

aux 0 1 = []

aux 1 1 = [[1]]

aux 2 1 = []

aux 3 1 = []

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

| otherwise = []

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

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

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Int -> Bool

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

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

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Int -> Int

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

nDescomposiciones2 :: Int -> Int

nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]

descomposiciones2 x = a ! (x,4)

where

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

f 0 1 = []

f 1 1 = [[1]]

f 2 1 = []

f 3 1 = []

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

| otherwise = []

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

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

-- 3ª solución

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

nDescomposiciones3 :: Int -> Int

nDescomposiciones3 x = aux x 4

where

aux 0 1 = 0

aux 1 1 = 1

aux 2 1 = 0

aux 3 1 = 0

aux y 1 | esCuadrado y = 1

| otherwise = 0

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

-- 4ª solución

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

nDescomposiciones4 :: Int -> Int

nDescomposiciones4 x = a ! (x,4)

where

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

f 0 1 = 0

f 1 1 = 1

f 2 1 = 0

f 3 1 = 0

f i 1 | esCuadrado i = 1

| otherwise = 0

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

-- Comprobación de equivalencia

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

-- La propiedad es

prop_nDescomposiciones :: Positive Int -> Bool

prop_nDescomposiciones (Positive x) =

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

, nDescomposiciones3

, nDescomposiciones4]]

-- La comprobación es

-- λ> quickCheck prop_nDescomposiciones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> nDescomposiciones 20000

-- 1068

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

-- λ> nDescomposiciones2 20000

-- 1068

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

-- λ> nDescomposiciones3 20000

-- 1068

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

-- λ> nDescomposiciones4 20000

-- 1068

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

-- λ> nDescomposiciones2 50000

-- 5682

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

-- λ> nDescomposiciones4 50000

-- 5682

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

-- Definición de graficaDescomposiciones

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

graficaDescomposiciones :: Int -> IO ()

graficaDescomposiciones n =

plotList [ Key Nothing

, PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")

]

(map nDescomposiciones3 [0..n])

Pensamiento

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

Antonio Machado

Número de sumandos en suma de cuadrados

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

El teorema de Lagrange de los cuatro cuadrados asegura que cualquier número entero positivo es la suma de, como máximo,cuatro cuadrados de números enteros. Por ejemplo,

   16 = 4²
   29 = 2² + 5²  
   14 = 1² + 2² + 3²
   15 = 1² + 1² + 2² + 3²

16 = 4²

29 = 2² + 5²

14 = 1² + 2² + 3²

15 = 1² + 1² + 2² + 3²

Definir las funciones

   ordenLagrange        :: Integer -> Int
   graficaOrdenLagrange :: Integer -> IO ()

1 2	ordenLagrange :: Integer -> Int graficaOrdenLagrange :: Integer -> IO ()

tales que

(ordenLagrange n) es el menor número de cuadrados necesarios para escribir n como suma de cuadrados. Por ejemplo.

     ordenLagrange 16     ==  1
     ordenLagrange 29     ==  2
     ordenLagrange 14     ==  3
     ordenLagrange 15     ==  4
     ordenLagrange 10000  ==  1
     ordenLagrange 10001  ==  2
     ordenLagrange 10002  ==  3
     ordenLagrange 10007  ==  4

ordenLagrange 16 == 1

ordenLagrange 29 == 2

ordenLagrange 14 == 3

ordenLagrange 15 == 4

ordenLagrange 10000 == 1

ordenLagrange 10001 == 2

ordenLagrange 10002 == 3

ordenLagrange 10007 == 4

(graficaOrdenLagrange n) dibuja la gráfica de los órdenes de Lagrange de los n primeros números naturales. Por ejemplo, (graficaOrdenLagrange 100) dibuja

Comprobar con QuickCheck que. para todo entero positivo k, el orden de Lagrange de k es menos o igual que 4, el de 4k+3 es distinto de 2 y el de 8k+7 es distinto de 3.

Soluciones

import Data.Array (Array, (!), array)
import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

ordenLagrange :: Integer -> Int
ordenLagrange n
  | esCuadrado n = 1
  | otherwise    = 1 + minimum [ ordenLagrange (n - x^2)
                               | x <- [1..raizEntera n]]

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

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

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

ordenLagrange2 :: Integer -> Int
ordenLagrange2 n = (vectorOrdenLagrange n) ! n

vectorOrdenLagrange :: Integer -> Array Integer Int
vectorOrdenLagrange n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f i | esCuadrado i = 1
      | otherwise    = 1 + minimum [ v ! (i - j^2)
                                   | j <- [1..raizEntera i]]

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

-- La comparación es
--    λ> ordenLagrange 50
--    2
--    (10.39 secs, 1,704,144,464 bytes)
--    λ> ordenLagrange2 50
--    2
--    (0.01 secs, 341,920 bytes)

-- Definición de graficaOrdenLagrange
-- ==================================

graficaOrdenLagrange :: Integer -> IO ()
graficaOrdenLagrange n = 
  plotList [ Key Nothing
           , PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")
           ]
           (map ordenLagrange2 [0..n-1])

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

-- La propiedad es
prop_OrdenLagrange :: Positive Integer -> Bool
prop_OrdenLagrange (Positive k) =
  ordenLagrange2 k <= 4 &&
  ordenLagrange2 (4*k+3) /= 2 &&
  ordenLagrange2 (8*k+7) /= 3

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

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

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

ordenLagrange :: Integer -> Int

ordenLagrange n

| esCuadrado n = 1

| otherwise = 1 + minimum [ ordenLagrange (n - x^2)

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

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

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

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

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª definición

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

ordenLagrange2 :: Integer -> Int

ordenLagrange2 n = (vectorOrdenLagrange n) ! n

vectorOrdenLagrange :: Integer -> Array Integer Int

vectorOrdenLagrange n = v where

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

f i | esCuadrado i = 1

| otherwise = 1 + minimum [ v ! (i - j^2)

| j <- [1..raizEntera i]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenLagrange 50

-- 2

-- (10.39 secs, 1,704,144,464 bytes)

-- λ> ordenLagrange2 50

-- 2

-- (0.01 secs, 341,920 bytes)

-- Definición de graficaOrdenLagrange

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

graficaOrdenLagrange :: Integer -> IO ()

graficaOrdenLagrange n =

plotList [ Key Nothing

, PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")

]

(map ordenLagrange2 [0..n-1])

-- Comprobación de la propiedad

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

-- La propiedad es

prop_OrdenLagrange :: Positive Integer -> Bool

prop_OrdenLagrange (Positive k) =

ordenLagrange2 k <= 4 &&

ordenLagrange2 (4*k+3) /= 2 &&

ordenLagrange2 (8*k+7) /= 3

-- La comprobación es

-- λ> quickCheck prop_OrdenLagrange

-- +++ OK, passed 100 tests.

Pensamiento

— Nuestro español bosteza.
¿Es hambre? ¿Sueño? ¿Hastío?
Doctor, ¿tendrá el estómago vacío?
— El vacío es más bien en la cabeza.

Antonio Machado

Mayor exponente

PorJosé A. Alonso 20-febrero-201927-febrero-2019

Definir las funciones

   mayorExponente        :: Integer -> Integer
   graficaMayorExponente :: Integer -> IO ()

1 2	mayorExponente :: Integer -> Integer graficaMayorExponente :: Integer -> IO ()

tales que

(mayorExponente n) es el mayor número b para el que existe un a tal que n = a^b. Se supone que n > 1. Por ejemplo,

     mayorExponente 9   ==  2
     mayorExponente 8   ==  3
     mayorExponente 7   ==  1
     mayorExponente 18  ==  1
     mayorExponente 36  ==  2
     mayorExponente (10^(10^5))  ==  100000

mayorExponente 9 == 2

mayorExponente 8 == 3

mayorExponente 7 == 1

mayorExponente 18 == 1

mayorExponente 36 == 2

mayorExponente (10^(10^5)) == 100000

(graficaMayorExponente n) dibuja la gráfica de los mayores exponentes de los números entre 2 y n. Por ejemplo, (graficaMayorExponente 50) dibuja

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
import Graphics.Gnuplot.Simple


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

mayorExponente :: Integer -> Integer
mayorExponente x =
  last [b | b <- [1..x]
          , a <- [1..x]
          , a^b == x]

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

mayorExponente2 :: Integer -> Integer
mayorExponente2 x =
  head [b | b <- [x,x-1..1]
          , a <- [1..x]
          , a^b == x]

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

mayorExponente3 :: Integer -> Integer
mayorExponente3 x = aux x
  where aux 1 = 1
        aux b | any (\a -> a^b == x) [1..x] = b
              | otherwise                   = aux (b-1)

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

mayorExponente4 :: Integer -> Integer
mayorExponente4 x =
  mcd (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorizacioń de
-- x. por ejemplo.
--    exponentes 720  ==  [4,2,1]
exponentes :: Integer -> [Integer]
exponentes x =
  map genericLength (group (primeFactors x))

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
mcd :: [Integer] -> Integer
mcd = foldr1 gcd

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

-- La propiedad es
prop_mayorExponente :: Integer -> Property
prop_mayorExponente n =
  n >= 0 ==>
  mayorExponente  n == mayorExponente2 n &&
  mayorExponente2 n == mayorExponente3 n

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

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

--    λ> mayorExponente (10^3)
--    3
--    (3.96 secs, 4,671,928,464 bytes)
--    λ> mayorExponente2 (10^3)
--    3
--    (3.99 secs, 4,670,107,024 bytes)
--    λ> mayorExponente3 (10^3)
--    3
--    (3.90 secs, 4,686,383,952 bytes)
--    λ> mayorExponente4 (10^3)
--    3
--    (0.02 secs, 131,272 bytes)

-- Definición de graficaMayorExponente
-- ======================================

graficaMayorExponente :: Integer -> IO ()
graficaMayorExponente n = 
  plotList [ Key Nothing
           , PNG ("MayorExponente.png")
           ]
           (map mayorExponente3 [2..n])

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª solución

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

mayorExponente :: Integer -> Integer

mayorExponente x =

last [b | b <- [1..x]

, a <- [1..x]

, a^b == x]

-- 2ª solución

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

mayorExponente2 :: Integer -> Integer

mayorExponente2 x =

head [b | b <- [x,x-1..1]

, a <- [1..x]

, a^b == x]

-- 3ª solución

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

mayorExponente3 :: Integer -> Integer

mayorExponente3 x = aux x

where aux 1 = 1

aux b | any (\a -> a^b == x) [1..x] = b

| otherwise = aux (b-1)

-- 4ª solución

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

mayorExponente4 :: Integer -> Integer

mayorExponente4 x =

mcd (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorizacioń de

-- x. por ejemplo.

-- exponentes 720 == [4,2,1]

exponentes :: Integer -> [Integer]

exponentes x =

map genericLength (group (primeFactors x))

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,

-- mcd [4,6,10] == 2

mcd :: [Integer] -> Integer

mcd = foldr1 gcd

-- Comprobación de equivalencia

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

-- La propiedad es

prop_mayorExponente :: Integer -> Property

prop_mayorExponente n =

n >= 0 ==>

mayorExponente n == mayorExponente2 n &&

mayorExponente2 n == mayorExponente3 n

-- La comprobación es

-- λ> quickCheck prop_mayorExponente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> mayorExponente (10^3)

-- 3

-- (3.96 secs, 4,671,928,464 bytes)

-- λ> mayorExponente2 (10^3)

-- 3

-- (3.99 secs, 4,670,107,024 bytes)

-- λ> mayorExponente3 (10^3)

-- 3

-- (3.90 secs, 4,686,383,952 bytes)

-- λ> mayorExponente4 (10^3)

-- 3

-- (0.02 secs, 131,272 bytes)

-- Definición de graficaMayorExponente

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

graficaMayorExponente :: Integer -> IO ()

graficaMayorExponente n =

plotList [ Key Nothing

, PNG ("MayorExponente.png")

]

(map mayorExponente3 [2..n])

Pensamiento

Mirando mi calavera
un nuevo Hamlet dirá:
He aquí un lindo fósil de una
careta de carnaval.

Antonio Machado

Mezcla de listas

PorJosé A. Alonso 19-febrero-201926-febrero-2019

Definir la función

   mezcla :: [[a]] -> [a]

1	mezcla :: [[a]] -> [a]

tal que (mezcla xss) es la lista tomando sucesivamente los elementos de xss en la misma posición. Cuando una de las listas de xss es vacía, se continua con las restantes. por ejemplo,

   mezcla [[1,2],[3..7],[8..10]]            ==  [1,3,8,2,4,9,5,10,6,7]
   mezcla ["Estamos","en","2019"]           ==  "Ee2sn0t1a9mos"
   take 9 (mezcla [[3,6..],[5,7..],[0,1]])  ==  [3,5,0,6,7,1,9,9,12]

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

mezcla ["Estamos","en","2019"] == "Ee2sn0t1a9mos"

take 9 (mezcla [[3,6..],[5,7..],[0,1]]) == [3,5,0,6,7,1,9,9,12]

Soluciones

import Data.List (transpose)

-- 1ª solución
mezcla :: [[a]] -> [a]
mezcla xss = aux (filter (not . null) xss)
  where
    aux []  = []
    aux yss = map head yss ++ mezcla (map tail yss)

-- 2ª solución
mezcla2 :: [[a]] -> [a]
mezcla2 = aux . filter (not . null)
  where
    aux []  = []
    aux yss = map head yss ++ mezcla (map tail yss)

-- 3ª solución
mezcla3 :: [[a]] -> [a]
mezcla3 = concatMap primeros . takeWhile (not . null) . iterate restos
  where primeros = map head . filter (not . null)
        restos   = map tail . filter (not . null)

-- 4ª solución
mezcla4 :: [[a]] -> [a]
mezcla4 = concat . transpose

import Data.List (transpose)

-- 1ª solución

mezcla :: [[a]] -> [a]

mezcla xss = aux (filter (not . null) xss)

where

aux [] = []

aux yss = map head yss ++ mezcla (map tail yss)

-- 2ª solución

mezcla2 :: [[a]] -> [a]

mezcla2 = aux . filter (not . null)

where

aux [] = []

aux yss = map head yss ++ mezcla (map tail yss)

-- 3ª solución

mezcla3 :: [[a]] -> [a]

mezcla3 = concatMap primeros . takeWhile (not . null) . iterate restos

where primeros = map head . filter (not . null)

restos = map tail . filter (not . null)

-- 4ª solución

mezcla4 :: [[a]] -> [a]

mezcla4 = concat . transpose

Pensamiento

Cuatro cosas tiene el hombre
que no sirven en la mar:
ancla, gobernalle y remos,
y miedo de naufragar.

Antonio Machado

Sucesión de Cantor de números innombrables

PorJosé A. Alonso 15-febrero-201922-febrero-2019

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

1	1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23

24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41 (9) 43

44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62

(2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)

(25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)

(30) 99 100

Definir las funciones

   sucCantor        :: [Integer]
   graficaSucCantor :: Int -> IO ()

1 2	sucCantor :: [Integer] graficaSucCantor :: Int -> IO ()

tales que

sucCantor es la lista cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,

     λ> take 100 sucCantor
     [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
      22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
      40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
      13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
      20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
      6, 92,93,94,95,96, 29, 30 ,99,100]
     λ> sucCantor2 !! (5+10^6)
     544480
     λ> sucCantor2 !! (6+10^6)
     266086

λ> take 100 sucCantor

[1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,

22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,

40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,

13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,

20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,

6, 92,93,94,95,96, 29, 30 ,99,100]

λ> sucCantor2 !! (5+10^6)

544480

λ> sucCantor2 !! (6+10^6)

266086

(graficaSucCantor n) es la gráfica de los n primeros términos de la sucesión de Cantor. Por ejemplo, (graficaSucCantor 200) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)

esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x

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

sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1) 

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

sucCantor3 :: [Integer]
sucCantor3 = 1 : aux [2..] sucCantor3
  where aux [] _ = []
        aux (x:xs) a@(y:ys)
          | esInnombrable x = y : aux xs ys
          | otherwise       = x : aux xs a

-- Definición de graficaSucCantor
-- ========================================

graficaSucCantor :: Int -> IO ()
graficaSucCantor n =
  plotList [ Key Nothing
           , PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")
           ]
           (take n sucCantor3)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

sucCantor1 :: [Integer]

sucCantor1 = map fst $ scanl f (1,0) [2..]

where f (a,i) x

| esInnombrable x = (sucCantor1 !! i, i+1)

| otherwise = (x,i)

esInnombrable :: Integer -> Bool

esInnombrable x =

rem x 7 == 0 || '7' `elem` show x

-- 2ª solución

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

sucCantor2 :: [Integer]

sucCantor2 = aux 0 1

where aux i x

| esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)

| otherwise = x : aux i (x+1)

-- 3ª solución

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

sucCantor3 :: [Integer]

sucCantor3 = 1 : aux [2..] sucCantor3

where aux [] _ = []

aux (x:xs) a@(y:ys)

| esInnombrable x = y : aux xs ys

| otherwise = x : aux xs a

-- Definición de graficaSucCantor

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

graficaSucCantor :: Int -> IO ()

graficaSucCantor n =

plotList [ Key Nothing

, PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")

]

(take n sucCantor3)

Pensamiento

Dices que nada se pierde
y acaso dices verdad;
pero todo lo perdemos
y todo nos perderá.

Antonio Machado

Medias de dígitos de pi

PorJosé A. Alonso 5-febrero-201925-abril-2021

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

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir las funciones

   mediasDigitosDePi        :: IO [Double]
   graficaMediasDigitosDePi :: Int -> IO ()

1 2	mediasDigitosDePi :: IO [Double] graficaMediasDigitosDePi :: Int -> IO ()

tales que

mediasDigitosDePi es la sucesión cuyo n-ésimo elemento es la media de los n primeros dígitos de pi. Por ejemplo,

     λ> xs <- mediasDigitosDePi
     λ> take 5 xs
     [1.0,2.5,2.0,2.75,4.0]
     λ> take 10 xs
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
     λ> take 10 <$> mediasDigitosDePi
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> xs <- mediasDigitosDePi

λ> take 5 xs

[1.0,2.5,2.0,2.75,4.0]

λ> take 10 xs

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> take 10 <$> mediasDigitosDePi

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

(graficaMediasDigitosDePi n) dibuja la gráfica de los n primeros términos de mediasDigitosDePi. Por ejemplo,
- (graficaMediasDigitosDePi 20) dibuja
- (graficaMediasDigitosDePi 200) dibuja
- (graficaMediasDigitosDePi 2000) dibuja

Soluciones

import Data.Char (digitToInt)
import Data.List (genericLength, inits, tails)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de mediasDigitosDePi
-- ===============================

mediasDigitosDePi :: IO [Double]
mediasDigitosDePi = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,
--    digitos "1415926535"  ==  [1,4,1,5,9,2,6,5,3,5]
digitos :: String -> [Int]
digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de
-- xs. Por ejemplo,
--    λ> medias [1,4,1,5,9,2,6,5,3,5]
--    [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
medias :: [Int] -> [Double]
medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,
--    media [1,4,1,5,9]  ==  4.0
media :: [Int] -> Double
media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi
-- ======================================

graficaMediasDigitosDePi :: Int -> IO ()
graficaMediasDigitosDePi n = do
  xs <- mediasDigitosDePi
  plotList [ Key Nothing
           , PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")
           ]
           (take n xs)

import Data.Char (digitToInt)

import Data.List (genericLength, inits, tails)

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

, plotList )

-- Definición de mediasDigitosDePi

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

mediasDigitosDePi :: IO [Double]

mediasDigitosDePi = do

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

return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,

-- digitos "1415926535" == [1,4,1,5,9,2,6,5,3,5]

digitos :: String -> [Int]

digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de

-- xs. Por ejemplo,

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

-- [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

medias :: [Int] -> [Double]

medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,

-- media [1,4,1,5,9] == 4.0

media :: [Int] -> Double

media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi

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

graficaMediasDigitosDePi :: Int -> IO ()

graficaMediasDigitosDePi n = do

xs <- mediasDigitosDePi

plotList [ Key Nothing

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

]

(take n xs)

Pensamiento

Es el mejor de los buenos
quien sabe que en esta vida
todo es cuestión de medida:
un poco más, algo menos.

Antonio Machado

Límites de sucesiones

PorJosé A. Alonso 4-febrero-201911-febrero-2019

El límite de una sucesión, con una aproximación a y una amplitud n, es el primer término x de la sucesión tal que el valor absoluto de x y cualquiera de sus n siguentes elementos es menor que a.

Definir la función

   limite :: [Double] -> Double -> Int -> Double

1	limite :: [Double] -> Double -> Int -> Double

tal que (limite xs a n) es el límite de xs xon aproximación a y amplitud n. Por ejemplo,

   λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300
   1.993991989319092
   λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300
   1.9998260062637745
   λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300
   2.7155953364173175

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300

1.993991989319092

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300

1.9998260062637745

λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300

2.7155953364173175

Soluciones

import Data.List (tails)

limite :: [Double] -> Double -> Int -> Double
limite xs a n = 
  head [ x | (x:ys) <- segmentos xs n
       , all (\y ->  abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs
-- con n elementos. Por ejemplo,   
--    λ> take 5 (segmentos [1..] 3)
--    [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]]
segmentos :: [a] -> Int -> [[a]]
segmentos xs n = map (take n) (tails xs)

import Data.List (tails)

limite :: [Double] -> Double -> Int -> Double

limite xs a n =

head [ x | (x:ys) <- segmentos xs n

, all (\y -> abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs

-- con n elementos. Por ejemplo,

-- λ> take 5 (segmentos [1..] 3)

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

segmentos :: [a] -> Int -> [[a]]

segmentos xs n = map (take n) (tails xs)

Pensamiento

De diez cabezas, nueve
embisten y una piensa.
Nunca extrañéis que un bruto
se descuerne luchando por la idea.

Antonio Machado

Triángulo de Pascal binario

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

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

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

1 0 1 1 1 1 0 1 1 0

1 1 0 0 1 1 0 1

0 1 0 0 1 1

1 1 1 0

0 1

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

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

Definir las funciones

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

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

pascalCapicuas :: Int -> [[Int]]

nPascalCapicuas :: Int -> Integer

tales que

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

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

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

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

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

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

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

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

λ> pascalCapicuas 2

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

λ> pascalCapicuas 3

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

λ> pascalCapicuas 4

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

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

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

λ> nPascalCapicuas 2

λ> nPascalCapicuas 3

λ> nPascalCapicuas 4

λ> nPascalCapicuas 400

1606938044258990275541962092341162602522202993782792835301376

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

15052

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

150515

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

1505150

Soluciones

import Data.List (genericLength, unfoldr)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario

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

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

trianguloPascalBinario xs =

takeWhile (not . null) (iterate siguiente xs)

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

-- de Pascal. Por ejemplo,

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

-- [1,1,0,0]

-- λ> siguiente it

-- [0,1,0]

-- λ> siguiente it

-- [1,1]

-- λ> siguiente it

-- [0]

-- λ> siguiente it

-- []

-- λ> siguiente it

-- []

siguiente :: [Int] -> [Int]

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

-- 2ª definición de trianguloPascalBinario

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

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

trianguloPascalBinario2 = unfoldr f

where f [] = Nothing

f xs = Just (xs, siguiente xs)

-- Definición de pascalCapicuas

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

pascalCapicuas :: Int -> [[Int]]

pascalCapicuas n =

[xs | xs <- inicios n

, esPascalCapicua xs]

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

-- ejemplo,

-- λ> inicios 0

-- [[]]

-- λ> inicios 1

-- [[0],[1]]

-- λ> inicios 2

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

-- λ> inicios 3

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

inicios :: Int -> [[Int]]

inicios 0 = [[]]

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

where xss = inicios (n-1)

-- Otra forma de definir inicios es

inicios2 :: Int -> [[Int]]

inicios2 n = sucInicios !! n

where sucInicios = iterate siguiente [[]]

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

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

-- capicúa. Por ejemplo,

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

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

esPascalCapicua :: [Int] -> Bool

esPascalCapicua xs =

xs == finalesTrianguloPascalBinario xs

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

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

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

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

finalesTrianguloPascalBinario :: [Int] -> [Int]

finalesTrianguloPascalBinario =

reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas

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

nPascalCapicuas :: Int -> Integer

nPascalCapicuas =

genericLength . pascalCapicuas

-- 2ª definición de nPascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer

nPascalCapicuas2 n =

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

Pensamiento

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

Antonio Machado

Impares en filas del triángulo de Pascal

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

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

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

1 1

1 2 1

1 3 3 1

1 4 6 4 1

1 5 10 10 5 1

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

construido de la siguiente forma

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

Definir las funciones

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

imparesPascal :: [[Integer]]

nImparesPascal :: [Int]

grafica_nImparesPascal :: Int -> IO ()

tales que

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

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

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

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

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

λ> take 32 nImparesPascal

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

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

524288

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

y (grafica_nImparesPascal 100) dibuja

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

Soluciones

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

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

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

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

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

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

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

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

nImparesPascal :: [Int]
nImparesPascal =
  map length imparesPascal

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

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

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

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

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

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

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

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

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

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

import Data.List (transpose)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de imparesPascal

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

imparesPascal :: [[Integer]]

imparesPascal =

map (filter odd) pascal

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

-- λ> take 7 pascal

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

pascal :: [[Integer]]

pascal = [1] : map f pascal

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

-- 2ª definición de imparesPascal

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

imparesPascal2 :: [[Integer]]

imparesPascal2 =

map (filter odd) pascal

pascal2 :: [[Integer]]

pascal2 = iterate f [1]

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

-- 1ª definición de nImparesPascal

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

nImparesPascal :: [Int]

nImparesPascal =

map length imparesPascal

-- 2ª definición de nImparesPascal

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

nImparesPascal2 :: [Int]

nImparesPascal2 =

map (length . filter odd) imparesPascal

-- 3ª definición de nImparesPascal

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

-- λ> take 32 nImparesPascal2

-- [1,2,

-- 2,4,

-- 2,4,4,8,

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

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

nImparesPascal3 :: [Int]

nImparesPascal3 = 1 : zs

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

-- Definición de grafica_nImparesPascal

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

grafica_nImparesPascal :: Int -> IO ()

grafica_nImparesPascal n =

plotListStyle

[ Key Nothing

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

]

(defaultStyle {plotType = LinesPoints})

(take n nImparesPascal3)

-- Propiedad de nImparesPascal

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

-- La propiedad es

prop_nImparesPascal :: Positive Int -> Bool

prop_nImparesPascal (Positive n) =

esPotenciaDeDos (nImparesPascal3 !! n)

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

-- ejemplo,

-- esPotenciaDeDos 16 == True

-- esPotenciaDeDos 18 == False

esPotenciaDeDos :: Int -> Bool

esPotenciaDeDos 1 = True

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

-- La comprobación es

-- λ> quickCheck prop_nImparesPascal

-- +++ OK, passed 100 tests.

Pensamiento

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

Antonio Machado

Números con dígitos 1 y 2

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

Definir las funciones

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

numerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 :: Int -> [Int]

grafica_restosNumerosCon1y2 :: Int -> IO ()

tales que

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

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

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

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

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

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

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

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

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

(graficaRestosNumerosCon1y2 4) dibuja

y (graficaRestosNumerosCon1y2 5) dibuja

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

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

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

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

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

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

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

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

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

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

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

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

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

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

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

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2

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

numerosCon1y2 :: Int -> [Int]

numerosCon1y2 = map digitosAnumero . digitos

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

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

-- λ> digitos 2

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

-- λ> digitos 3

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

digitos :: Int -> [[Int]]

digitos 0 = [[]]

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

where xss = digitos (n-1)

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

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

digitosAnumero :: [Int] -> Int

digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2

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

restosNumerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 n =

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

where m = 2^n

-- Definición de graficaRestosNumerosCon1y2

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

graficaRestosNumerosCon1y2 :: Int -> IO ()

graficaRestosNumerosCon1y2 n =

plotListStyle

[ Key Nothing

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

]

(defaultStyle {plotType = LinesPoints,

lineSpec = CustomStyle [PointType 7]})

(restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2

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

-- La propiedad

prop_restosNumerosCon1y2 :: Positive Int -> Bool

prop_restosNumerosCon1y2 (Positive n) =

todosDistintos (restosNumerosCon1y2 n)

where todosDistintos xs = xs == nub xs

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Pensamiento

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

Antonio Machado

Representación de conjuntos mediante intervalos

PorJosé A. Alonso 15-enero-201922-enero-2019

Un conjunto de números enteros se pueden representar mediante una lista ordenada de intervalos tales que la diferencia entre el menor elemento de un intervalo y el mayor elemento de su intervalo anterior es mayor que uno.

Por ejemplo, el conjunto {2, 7, 4, 3, 9, 6} se puede representar mediante la lista de intervalos [(2,4),(6,7),(9,9)] de forma que en el primer intervalo se agrupan los números 2, 3 y 4; en el segundo, los números 6 y 7 y el tercero, el número 9.

Definir la función

   intervalos :: [Int] -> [(Int,Int)]

1	intervalos :: [Int] -> [(Int,Int)]

tal que (intervalos xs) es lista ordenada de intervalos que representa
al conjunto xs. Por ejemplo,

   λ> intervalos [2,7,4,3,9,6]
   [(2,4),(6,7),(9,9)]
   λ> intervalos [180,141,174,143,142,175]
   [(141,143),(174,175),(180,180)]

λ> intervalos [2,7,4,3,9,6]

[(2,4),(6,7),(9,9)]

λ> intervalos [180,141,174,143,142,175]

[(141,143),(174,175),(180,180)]

Soluciones

import Data.List (sort)

intervalos :: [Int] -> [(Int,Int)]
intervalos = map intervalo . segmentos

-- (segmentos xs) es la lista de segmentos formados por elementos
-- consecutivos de xs. Por ejemplo,
--    segmentos [2,7,4,3,9,6]  ==  [[2,3,4],[6,7],[9]]
segmentos :: [Int] -> [[Int]]
segmentos xs = aux as [[a]]
  where aux [] zs = zs
        aux (y:ys) ((a:as):zs) | y == a-1  = aux ys ((y:a:as):zs)
                               | otherwise = aux ys ([y]:(a:as):zs)
        (a:as) = reverse (sort xs)

-- (intervalo xs) es el intervalo correspondiente al segmento xs. Por
-- ejemplo, 
--    intervalo [2,3,4]  ==  (2,4)
--    intervalo [6,7]    ==  (6,7)
--    intervalo [9]      ==  (9,9)
intervalo :: [Int] -> (Int,Int)
intervalo xs = (head xs, last xs)

import Data.List (sort)

intervalos :: [Int] -> [(Int,Int)]

intervalos = map intervalo . segmentos

-- (segmentos xs) es la lista de segmentos formados por elementos

-- consecutivos de xs. Por ejemplo,

-- segmentos [2,7,4,3,9,6] == [[2,3,4],[6,7],[9]]

segmentos :: [Int] -> [[Int]]

segmentos xs = aux as [[a]]

where aux [] zs = zs

aux (y:ys) ((a:as):zs) | y == a-1 = aux ys ((y:a:as):zs)

| otherwise = aux ys ([y]:(a:as):zs)

(a:as) = reverse (sort xs)

-- (intervalo xs) es el intervalo correspondiente al segmento xs. Por

-- ejemplo,

-- intervalo [2,3,4] == (2,4)

-- intervalo [6,7] == (6,7)

-- intervalo [9] == (9,9)

intervalo :: [Int] -> (Int,Int)

intervalo xs = (head xs, last xs)

Pensamiento

Cuando el saber se especializa, crece el volumen total de la cultura. Esta es la ilusión y el consuelo de los especialistas. ¡Lo que sabemos entre todos! ¡Oh, eso es lo que no sabe nadie!

Antonio Machado

Mayor prefijo con suma acotada

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

Definir la función

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

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

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

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

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

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

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

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

Soluciones

import Data.List (inits)

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (inits)

-- 1ª solución

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

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

mayorPrefijoAcotado [] _ = []

mayorPrefijoAcotado (x:xs) y

| x > y = []

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

-- 2ª solución

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

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

mayorPrefijoAcotado2 xs y =

take (longitudMayorPrefijoAcotado2 xs y) xs

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

longitudMayorPrefijoAcotado2 xs y =

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

-- 3ª solución

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

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

mayorPrefijoAcotado3 xs y =

take (longitudMayorPrefijoAcotado3 xs y) xs

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

longitudMayorPrefijoAcotado3 xs y =

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

-- Equivalencia

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

-- La propiedad es

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

prop_equiv xs y =

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

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

where xs' = map abs xs

y' = abs y

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

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

-- Comparación de eficiencia

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

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

-- 20000

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

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

-- 20000

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

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

-- 20000

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

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

-- 8000000

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

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

-- 8000000

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

Pensamiento

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

Antonio Machado

Cadena descendiente de subnúmeros

PorJosé A. Alonso 7-enero-201914-enero-2019

Una particularidad del 2019 es que se puede escribir como una cadena de dos subnúmeros consecutivos (el 20 y el 19).

Definir la función

   cadena :: Integer -> [Integer]

1	cadena :: Integer -> [Integer]

tal que (cadena n) es la cadena de subnúmeros consecutivos de n cuya unión es n; es decir, es la lista de números [x,x-1,…x-k] tal que su concatenación es n. Por ejemplo,

   cadena 2019         == [20,19]
   cadena 2018         == [2018]
   cadena 1009         == [1009]
   cadena 110109       == [110,109]
   cadena 201200199198 == [201,200,199,198] 
   cadena 3246         == [3246]            
   cadena 87654        == [8,7,6,5,4]       
   cadena 123456       == [123456]          
   cadena 1009998      == [100,99,98]       
   cadena 100908       == [100908]          
   cadena 1110987      == [11,10,9,8,7]     
   cadena 210          == [2,1,0]           
   cadena 1            == [1]               
   cadena 0            == [0]               
   cadena 312          == [312]             
   cadena 191          == [191]
   length (cadena (read (concatMap show [2019,2018..0])))  ==  2020

cadena 2019 == [20,19]

cadena 2018 == [2018]

cadena 1009 == [1009]

cadena 110109 == [110,109]

cadena 201200199198 == [201,200,199,198]

cadena 3246 == [3246]

cadena 87654 == [8,7,6,5,4]

cadena 123456 == [123456]

cadena 1009998 == [100,99,98]

cadena 100908 == [100908]

cadena 1110987 == [11,10,9,8,7]

cadena 210 == [2,1,0]

cadena 1 == [1]

cadena 0 == [0]

cadena 312 == [312]

cadena 191 == [191]

length (cadena (read (concatMap show [2019,2018..0]))) == 2020

Nota: Los subnúmeros no pueden empezar por cero. Por ejemplo, [10,09] no es una cadena de 1009 como se observa en el tercer ejemplo.

Soluciones

import Test.QuickCheck
import Data.List (inits)

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

cadena :: Integer -> [Integer]
cadena = head . cadenasL . digitos

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

-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos
-- son xs. Por ejemplo,
--    cadenasL [2,0,1,9]      == [[20,19],[2019]]
--    cadenasL [1,0,0,9]      == [[1009]]
--    cadenasL [1,1,0,1,0,9]  == [[110,109],[110109]]
cadenasL :: [Integer] -> [[Integer]] 
cadenasL []       = []
cadenasL [x]      = [[x]]
cadenasL [1,0]    = [[1,0],[10]]
cadenasL (x:0:zs) = cadenasL (10*x:zs) 
cadenasL (x:y:zs) =
     [x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]
  ++ cadenasL (10*x+y:zs)

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

cadena2 :: Integer -> [Integer]
cadena2 n = (head . concatMap aux . iniciales) n 
  where aux x = [[x,x-1..x-k] | k <- [0..x]
                              , concatMap show [x,x-1..x-k] == ds]
        ds    = show n

-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por
-- ejemplo, 
--    iniciales 2019  ==  [2,20,201,2019]
iniciales :: Integer -> [Integer]
iniciales = map read . tail . inits . show

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

-- La propiedad es
prop_cadena :: (Positive Integer) -> Bool
prop_cadena (Positive n) =
  cadena n == cadena2 n 
  
-- La comprobación es
--    λ> quickCheck prop_cadena
--    +++ OK, passed 100 tests.

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

--    λ> length (cadena (read (concatMap show [15,14..0])))
--    16
--    (3.28 secs, 452,846,008 bytes)
--    λ> length (cadena2 (read (concatMap show [15,14..0])))
--    16
--    (0.03 secs, 176,360 bytes)

import Test.QuickCheck

import Data.List (inits)

-- 1ª solución

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

cadena :: Integer -> [Integer]

cadena = head . cadenasL . digitos

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

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

digitos :: Integer -> [Integer]

digitos n = [read [c] | c <- show n]

-- (cadenasL xs) son las cadenas descendientes del número cuyos dígitos

-- son xs. Por ejemplo,

-- cadenasL [2,0,1,9] == [[20,19],[2019]]

-- cadenasL [1,0,0,9] == [[1009]]

-- cadenasL [1,1,0,1,0,9] == [[110,109],[110109]]

cadenasL :: [Integer] -> [[Integer]]

cadenasL [] = []

cadenasL [x] = [[x]]

cadenasL [1,0] = [[1,0],[10]]

cadenasL (x:0:zs) = cadenasL (10*x:zs)

cadenasL (x:y:zs) =

[x:a:as | (a:as) <- cadenasL (y:zs), a == x-1]

++ cadenasL (10*x+y:zs)

-- 2ª solución

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

cadena2 :: Integer -> [Integer]

cadena2 n = (head . concatMap aux . iniciales) n

where aux x = [[x,x-1..x-k] | k <- [0..x]

, concatMap show [x,x-1..x-k] == ds]

ds = show n

-- (iniciales n) es la lista de los subnúmeros iniciales de n. Por

-- ejemplo,

-- iniciales 2019 == [2,20,201,2019]

iniciales :: Integer -> [Integer]

iniciales = map read . tail . inits . show

-- Equivalencia

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

-- La propiedad es

prop_cadena :: (Positive Integer) -> Bool

prop_cadena (Positive n) =

cadena n == cadena2 n

-- La comprobación es

-- λ> quickCheck prop_cadena

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (cadena (read (concatMap show [15,14..0])))

-- 16

-- (3.28 secs, 452,846,008 bytes)

-- λ> length (cadena2 (read (concatMap show [15,14..0])))

-- 16

-- (0.03 secs, 176,360 bytes)

Pensamiento

La inseguridad, la incertidumbre, la desconfianza, son acaso nuestras únicas verdades. Hay que aferrarse a ellas.

Antonio Machado

Árbol de subconjuntos

PorJosé A. Alonso 28-diciembre-20184-enero-2019

Se dice que A es un subconjunto maximal de B si A ⊂ B y no existe ningún C tal que A ⊂ C y C ⊂ B. Por ejemplo, {2,5} es un subconjunto maximal de {2,3,5], pero {3] no lo es.

El árbol de los subconjuntos de un conjunto A es el árbol que tiene como raíz el conjunto A y cada nodo tiene como hijos sus subconjuntos maximales. Por ejemplo, el árbol de subconjuntos de [2,3,5] es

          [2, 3, 5]
          /   |  \
         /    |   \  
        /     |    \   
       /      |     \
      /       |      \
    [5,3]   [2,3]   [2,5]  
    /  \    /  \    /  \  
   [3] [5] [3] [2] [5] [2]
    |   |   |   |   |   | 
   [ ] [ ] [ ] [ ] [ ] [ ]

[2, 3, 5]

/ | \

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

/ \ / \ / \

[3] [5] [3] [2] [5] [2]

| | | | | |

[ ] [ ] [ ] [ ] [ ] [ ]

Usando el tipo de dato

   data Arbol = N [Integer] [Arbol]
     deriving (Eq, Show)

1 2	data Arbol = N [Integer] [Arbol] deriving (Eq, Show)

el árbol anterior se representa por

   N [2,5,3]
     [N [5,3]
        [N [3]
           [N [] []],
         N [5]
           [N [] []]],
      N [2,3]
        [N [3]
           [N [] []],
         N [2]
           [N [] []]],
      N [2,5]
        [N [5]
           [N [] []],
         N [2]
           [N [] []]]]

N [2,5,3]

[N [5,3]

[N [3]

[N [] []],

N [5]

[N [] []]],

N [2,3]

[N [3]

[N [] []],

N [2]

[N [] []]],

N [2,5]

[N [5]

[N [] []],

N [2]

[N [] []]]]

Definir las funciones

   arbolSubconjuntos :: [Int] -> Arbol 
   nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int

1 2	arbolSubconjuntos :: [Int] -> Arbol nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int

tales que

(arbolSubconjuntos x) es el árbol de los subconjuntos de xs. Por ejemplo,

     λ> arbolSubconjuntos [2,5,3]
     N [2,5,3] [N [5,3] [N [3] [N [] []],N [5] [N [] []]],
                N [2,3] [N [3] [N [] []],N [2] [N [] []]],
                N [2,5] [N [5] [N [] []],N [2] [N [] []]]]

λ> arbolSubconjuntos [2,5,3]

N [2,5,3] [N [5,3] [N [3] [N [] []],N [5] [N [] []]],

N [2,3] [N [3] [N [] []],N [2] [N [] []]],

N [2,5] [N [5] [N [] []],N [2] [N [] []]]]

(nOcurrenciasArbolSubconjuntos xs ys) es el número de veces que aparece el conjunto xs en el árbol de los subconjuntos de ys. Por ejemplo,

     nOcurrenciasArbolSubconjuntos []      [2,5,3]  ==  6
     nOcurrenciasArbolSubconjuntos [3]     [2,5,3]  ==  2
     nOcurrenciasArbolSubconjuntos [3,5]   [2,5,3]  ==  1
     nOcurrenciasArbolSubconjuntos [3,5,2] [2,5,3]  ==  1

nOcurrenciasArbolSubconjuntos [] [2,5,3] == 6

nOcurrenciasArbolSubconjuntos [3] [2,5,3] == 2

nOcurrenciasArbolSubconjuntos [3,5] [2,5,3] == 1

nOcurrenciasArbolSubconjuntos [3,5,2] [2,5,3] == 1

Comprobar con QuickChek que, para todo entero positivo n, el número de ocurrencia de un subconjunto xs de [1..n] en el árbol de los subconjuntos de [1..n] es el factorial de n-k (donde k es el número de elementos de xs).

Soluciones

import Data.List (delete, nub, sort, subsequences)
import Test.QuickCheck

data Arbol = N [Int] [Arbol]
  deriving (Eq, Show)

arbolSubconjuntos :: [Int] -> Arbol 
arbolSubconjuntos xs =
  N xs (map arbolSubconjuntos (subconjuntosMaximales xs))

-- (subconjuntosMaximales xs) es la lista de los subconjuntos maximales
-- de xs. Por ejemplo,
--    subconjuntosMaximales [2,5,3]  ==  [[5,3],[2,3],[2,5]]
subconjuntosMaximales :: [Int] -> [[Int]]
subconjuntosMaximales xs =
  [delete x xs | x <- xs]

-- Definición de nOcurrenciasArbolSubconjuntos
-- ===========================================

nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int
nOcurrenciasArbolSubconjuntos xs ys =
  nOcurrencias xs (arbolSubconjuntos ys)

-- (nOcurrencias x a) es el número de veces que aparece x en el árbol
-- a. Por ejemplo,
--    nOcurrencias 3 (arbolSubconjuntos 30)  ==  2
nOcurrencias :: [Int] -> Arbol -> Int
nOcurrencias xs (N ys [])
  | conjunto xs == conjunto ys  = 1
  | otherwise                   = 0
nOcurrencias xs (N ys zs)
  | conjunto xs == conjunto ys = 1 + sum [nOcurrencias xs z | z <- zs]
  | otherwise                  = sum [nOcurrencias xs z | z <- zs]

-- (conjunto xs) es el conjunto ordenado correspondiente a xs. Por
-- ejemplo, 
--    conjunto [3,2,5,2,3,7,2]  ==  [2,3,5,7]
conjunto :: [Int] -> [Int]
conjunto = nub . sort

-- La propiedad es
prop_nOcurrencias :: (Positive Int) -> [Int] -> Bool
prop_nOcurrencias (Positive n) xs =
  nOcurrenciasArbolSubconjuntos ys [1..n] == factorial (n-k)
  where ys = nub [1 + x `mod` n | x <- xs]
        k  = length ys
        factorial m = product [1..m]

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

import Data.List (delete, nub, sort, subsequences)

import Test.QuickCheck

data Arbol = N [Int] [Arbol]

deriving (Eq, Show)

arbolSubconjuntos :: [Int] -> Arbol

arbolSubconjuntos xs =

N xs (map arbolSubconjuntos (subconjuntosMaximales xs))

-- (subconjuntosMaximales xs) es la lista de los subconjuntos maximales

-- de xs. Por ejemplo,

-- subconjuntosMaximales [2,5,3] == [[5,3],[2,3],[2,5]]

subconjuntosMaximales :: [Int] -> [[Int]]

subconjuntosMaximales xs =

[delete x xs | x <- xs]

-- Definición de nOcurrenciasArbolSubconjuntos

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

nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int

nOcurrenciasArbolSubconjuntos xs ys =

nOcurrencias xs (arbolSubconjuntos ys)

-- (nOcurrencias x a) es el número de veces que aparece x en el árbol

-- a. Por ejemplo,

-- nOcurrencias 3 (arbolSubconjuntos 30) == 2

nOcurrencias :: [Int] -> Arbol -> Int

nOcurrencias xs (N ys [])

| conjunto xs == conjunto ys = 1

| otherwise = 0

nOcurrencias xs (N ys zs)

| conjunto xs == conjunto ys = 1 + sum [nOcurrencias xs z | z <- zs]

| otherwise = sum [nOcurrencias xs z | z <- zs]

-- (conjunto xs) es el conjunto ordenado correspondiente a xs. Por

-- ejemplo,

-- conjunto [3,2,5,2,3,7,2] == [2,3,5,7]

conjunto :: [Int] -> [Int]

conjunto = nub . sort

-- La propiedad es

prop_nOcurrencias :: (Positive Int) -> [Int] -> Bool

prop_nOcurrencias (Positive n) xs =

nOcurrenciasArbolSubconjuntos ys [1..n] == factorial (n-k)

where ys = nub [1 + x `mod` n | x <- xs]

k = length ys

factorial m = product [1..m]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=9}) prop_nOcurrencias

-- +++ OK, passed 100 tests.

Pensamiento

Nunca traces tu frontera,
ni cuides de tu perfil;
todo eso es cosa de fuera.

Antonio Machado

Número de divisores compuestos

PorJosé A. Alonso 25-diciembre-20181-enero-2019

Definir la función

   nDivisoresCompuestos :: Integer -> Integer

1	nDivisoresCompuestos :: Integer -> Integer

tal que (nDivisoresCompuestos x) es el número de divisores de x que son compuestos (es decir, números mayores que 1 que no son primos). Por ejemplo,

   nDivisoresCompuestos 30  ==  4
   nDivisoresCompuestos (product [1..11])  ==  534
   nDivisoresCompuestos (product [1..25])  ==  340022
   length (show (nDivisoresCompuestos (product [1..3*10^4]))) == 1948

nDivisoresCompuestos 30 == 4

nDivisoresCompuestos (product [1..11]) == 534

nDivisoresCompuestos (product [1..25]) == 340022

length (show (nDivisoresCompuestos (product [1..3*10^4]))) == 1948

Soluciones

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

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

--    nDivisoresCompuestos 30  ==  4
nDivisoresCompuestos :: Integer -> Integer
nDivisoresCompuestos =
  genericLength . divisoresCompuestos

-- (divisoresCompuestos x) es la lista de los divisores de x que
-- son números compuestos (es decir, números mayores que 1 que no son
-- primos). Por ejemplo,
--    divisoresCompuestos 30  ==  [6,10,15,30]
divisoresCompuestos :: Integer -> [Integer]
divisoresCompuestos =
  sort
  . map product
  . compuestos
  . map concat
  . productoCartesiano
  . map inits
  . group
  . primeFactors
  where compuestos xss = [xs | xs <- xss, length xs > 1]  

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos xss. Por
-- ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]
  
-- 2ª solución
-- ===========

nDivisoresCompuestos2 :: Integer -> Integer
nDivisoresCompuestos2 x =
  nDivisores x - nDivisoresPrimos x - 1

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

-- (nDivisoresPrimos x) es el número de divisores primos de x. Por
-- ejemplo,  
--    nDivisoresPrimos 30  ==  3
nDivisoresPrimos :: Integer -> Integer
nDivisoresPrimos =
  genericLength . group . primeFactors 

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

nDivisoresCompuestos3 :: Integer -> Integer
nDivisoresCompuestos3 x =
  nDivisores - nDivisoresPrimos - 1
  where xss              = group (primeFactors x)
        nDivisores       = product [1 + genericLength xs | xs <-xss]
        nDivisoresPrimos = genericLength xss

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

-- La propiedad es
prop_nDivisoresCompuestos :: (Positive Integer) -> Bool
prop_nDivisoresCompuestos (Positive x) =
  all (== nDivisoresCompuestos x) [f x | f <- [ nDivisoresCompuestos2
                                              , nDivisoresCompuestos3 ]]

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

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

--    λ> nDivisoresCompuestos (product [1..25])
--    340022
--    (2.04 secs, 2,232,146,776 bytes)
--    λ> nDivisoresCompuestos2 (product [1..25])
--    340022
--    (0.00 secs, 220,192 bytes)
--    
--    λ> length (show (nDivisoresCompuestos2 (product [1..3*10^4])))
--    1948
--    (5.22 secs, 8,431,630,288 bytes)
--    λ> length (show (nDivisoresCompuestos3 (product [1..3*10^4])))
--    1948
--    (3.06 secs, 4,662,277,664 bytes)

import Data.List (genericLength, group, inits, sort)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

-- nDivisoresCompuestos 30 == 4

nDivisoresCompuestos :: Integer -> Integer

nDivisoresCompuestos =

genericLength . divisoresCompuestos

-- (divisoresCompuestos x) es la lista de los divisores de x que

-- son números compuestos (es decir, números mayores que 1 que no son

-- primos). Por ejemplo,

-- divisoresCompuestos 30 == [6,10,15,30]

divisoresCompuestos :: Integer -> [Integer]

divisoresCompuestos =

sort

. map product

. compuestos

. map concat

. productoCartesiano

. map inits

. group

. primeFactors

where compuestos xss = [xs | xs <- xss, length xs > 1]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos xss. Por

-- ejemplo,

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

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

nDivisoresCompuestos2 :: Integer -> Integer

nDivisoresCompuestos2 x =

nDivisores x - nDivisoresPrimos x - 1

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

-- nDivisores 30 == 8

nDivisores :: Integer -> Integer

nDivisores x =

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

-- (nDivisoresPrimos x) es el número de divisores primos de x. Por

-- ejemplo,

-- nDivisoresPrimos 30 == 3

nDivisoresPrimos :: Integer -> Integer

nDivisoresPrimos =

genericLength . group . primeFactors

-- 3ª solución

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

nDivisoresCompuestos3 :: Integer -> Integer

nDivisoresCompuestos3 x =

nDivisores - nDivisoresPrimos - 1

where xss = group (primeFactors x)

nDivisores = product [1 + genericLength xs | xs <-xss]

nDivisoresPrimos = genericLength xss

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_nDivisoresCompuestos :: (Positive Integer) -> Bool

prop_nDivisoresCompuestos (Positive x) =

all (== nDivisoresCompuestos x) [f x | f <- [ nDivisoresCompuestos2

, nDivisoresCompuestos3 ]]

-- La comprobación es

-- λ> quickCheck prop_nDivisoresCompuestos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> nDivisoresCompuestos (product [1..25])

-- 340022

-- (2.04 secs, 2,232,146,776 bytes)

-- λ> nDivisoresCompuestos2 (product [1..25])

-- 340022

-- (0.00 secs, 220,192 bytes)

-- λ> length (show (nDivisoresCompuestos2 (product [1..3*10^4])))

-- 1948

-- (5.22 secs, 8,431,630,288 bytes)

-- λ> length (show (nDivisoresCompuestos3 (product [1..3*10^4])))

-- 1948

-- (3.06 secs, 4,662,277,664 bytes)

Pensamiento

«Lo corriente en el hombre es la tendencia a creer verdadero cuanto le
reporta alguna utilidad. Por eso hay tantos hombres capaces de comulgar
con ruedas de molino.»

Antonio Machado

Divisores compuestos

PorJosé A. Alonso 24-diciembre-201831-diciembre-2018

Definir la función

   divisoresCompuestos :: Integer -> [Integer]

1	divisoresCompuestos :: Integer -> [Integer]

tal que (divisoresCompuestos x) es la lista de los divisores de x que son números compuestos (es decir, números mayores que 1 que no son primos). Por ejemplo,

   divisoresCompuestos 30  ==  [6,10,15,30]
   length (divisoresCompuestos (product [1..11]))  ==  534
   length (divisoresCompuestos (product [1..14]))  ==  2585
   length (divisoresCompuestos (product [1..16]))  ==  5369
   length (divisoresCompuestos (product [1..25]))  ==  340022

divisoresCompuestos 30 == [6,10,15,30]

length (divisoresCompuestos (product [1..11])) == 534

length (divisoresCompuestos (product [1..14])) == 2585

length (divisoresCompuestos (product [1..16])) == 5369

length (divisoresCompuestos (product [1..25])) == 340022

Soluciones

import Data.List (group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

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

divisoresCompuestos :: Integer -> [Integer]
divisoresCompuestos x =
  [y | y <- divisores x
     , y > 1
     , not (isPrime y)]

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

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

divisoresCompuestos2 :: Integer -> [Integer]
divisoresCompuestos2 x =
  [y | y <- divisores2 x
     , y > 1
     , not (isPrime y)]

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

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

divisoresCompuestos3 :: Integer -> [Integer]
divisoresCompuestos3 x =
  [y | y <- divisores2 x
     , y > 1
     , not (isPrime y)]

-- (divisores3 x) es la lista de los divisores de x. Por ejemplo,
--    divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores3 :: Integer -> [Integer]
divisores3 x =
  nub (sort (ys ++ [x `div` y | y <- ys]))
  where ys = [y | y <- [1..floor (sqrt (fromIntegral x))]
                , x `mod` y == 0]
             
-- 4ª solución
-- ===========

divisoresCompuestos4 :: Integer -> [Integer]
divisoresCompuestos4 x =
  [y | y <- divisores4 x
     , y > 1
     , not (isPrime y)]

-- (divisores4 x) es la lista de los divisores de x. Por ejemplo,
--    divisores4 30  ==  [1,2,3,5,6,10,15,30]
divisores4 :: Integer -> [Integer]
divisores4 =
  nub . sort . map product . subsequences . primeFactors

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

divisoresCompuestos5 :: Integer -> [Integer]
divisoresCompuestos5 x =
  [y | y <- divisores5 x
     , y > 1
     , not (isPrime y)]

-- (divisores5 x) es la lista de los divisores de x. Por ejemplo,
--    divisores5 30  ==  [1,2,3,5,6,10,15,30]
divisores5 :: Integer -> [Integer]
divisores5 =
  sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]
  
-- 6ª solución
-- ===========

divisoresCompuestos6 :: Integer -> [Integer]
divisoresCompuestos6 =
  sort
  . map product
  . compuestos
  . map concat
  . productoCartesiano
  . map inits
  . group
  . primeFactors
  where compuestos xss = [xs | xs <- xss, length xs > 1]  

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

-- La propiedad es
prop_divisoresCompuestos :: (Positive Integer) -> Bool
prop_divisoresCompuestos (Positive x) =
  all (== divisoresCompuestos x) [f x | f <- [ divisoresCompuestos2
                                             , divisoresCompuestos3
                                             , divisoresCompuestos4
                                             , divisoresCompuestos5
                                             , divisoresCompuestos6 ]]

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

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

--    λ> length (divisoresCompuestos (product [1..11]))
--    534
--    (14.59 secs, 7,985,108,976 bytes)
--    λ> length (divisoresCompuestos2 (product [1..11]))
--    534
--    (7.36 secs, 3,993,461,168 bytes)
--    λ> length (divisoresCompuestos3 (product [1..11]))
--    534
--    (7.35 secs, 3,993,461,336 bytes)
--    λ> length (divisoresCompuestos4 (product [1..11]))
--    534
--    (0.07 secs, 110,126,392 bytes)
--    λ> length (divisoresCompuestos5 (product [1..11]))
--    534
--    (0.01 secs, 3,332,224 bytes)
--    λ> length (divisoresCompuestos6 (product [1..11]))
--    534
--    (0.01 secs, 1,869,776 bytes)
--    
--    λ> length (divisoresCompuestos4 (product [1..14]))
--    2585
--    (9.11 secs, 9,461,570,720 bytes)
--    λ> length (divisoresCompuestos5 (product [1..14]))
--    2585
--    (0.04 secs, 17,139,872 bytes)
--    λ> length (divisoresCompuestos6 (product [1..14]))
--    2585
--    (0.02 secs, 10,140,744 bytes)
--    
--    λ> length (divisoresCompuestos2 (product [1..16]))
--    5369
--    (1.97 secs, 932,433,176 bytes)
--    λ> length (divisoresCompuestos5 (product [1..16]))
--    5369
--    (0.03 secs, 37,452,088 bytes)
--    λ> length (divisoresCompuestos6 (product [1..16]))
--    5369
--    (0.03 secs, 23,017,480 bytes)
--    
--    λ> length (divisoresCompuestos5 (product [1..25]))
--    340022
--    (2.43 secs, 3,055,140,056 bytes)
--    λ> length (divisoresCompuestos6 (product [1..25]))
--    340022
--    (1.94 secs, 2,145,440,904 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

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

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

-- 1ª solución

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

divisoresCompuestos :: Integer -> [Integer]

divisoresCompuestos x =

[y | y <- divisores x

, y > 1

, not (isPrime y)]

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

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

divisores :: Integer -> [Integer]

divisores x =

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

, x `mod` y == 0]

-- 2ª solución

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

divisoresCompuestos2 :: Integer -> [Integer]

divisoresCompuestos2 x =

[y | y <- divisores2 x

, y > 1

, not (isPrime y)]

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

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

divisores2 :: Integer -> [Integer]

divisores2 x =

[y | y <- [1..x `div` 2], x `mod` y == 0] ++ [x]

-- 2ª solución

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

divisoresCompuestos3 :: Integer -> [Integer]

divisoresCompuestos3 x =

[y | y <- divisores2 x

, y > 1

, not (isPrime y)]

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

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

divisores3 :: Integer -> [Integer]

divisores3 x =

nub (sort (ys ++ [x `div` y | y <- ys]))

where ys = [y | y <- [1..floor (sqrt (fromIntegral x))]

, x `mod` y == 0]

-- 4ª solución

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

divisoresCompuestos4 :: Integer -> [Integer]

divisoresCompuestos4 x =

[y | y <- divisores4 x

, y > 1

, not (isPrime y)]

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

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

divisores4 :: Integer -> [Integer]

divisores4 =

nub . sort . map product . subsequences . primeFactors

-- 5ª solución

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

divisoresCompuestos5 :: Integer -> [Integer]

divisoresCompuestos5 x =

[y | y <- divisores5 x

, y > 1

, not (isPrime y)]

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

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

divisores5 :: Integer -> [Integer]

divisores5 =

sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

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

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 6ª solución

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

divisoresCompuestos6 :: Integer -> [Integer]

divisoresCompuestos6 =

sort

. map product

. compuestos

. map concat

. productoCartesiano

. map inits

. group

. primeFactors

where compuestos xss = [xs | xs <- xss, length xs > 1]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_divisoresCompuestos :: (Positive Integer) -> Bool

prop_divisoresCompuestos (Positive x) =

all (== divisoresCompuestos x) [f x | f <- [ divisoresCompuestos2

, divisoresCompuestos3

, divisoresCompuestos4

, divisoresCompuestos5

, divisoresCompuestos6 ]]

-- La comprobación es

-- λ> quickCheck prop_divisoresCompuestos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (divisoresCompuestos (product [1..11]))

-- 534

-- (14.59 secs, 7,985,108,976 bytes)

-- λ> length (divisoresCompuestos2 (product [1..11]))

-- 534

-- (7.36 secs, 3,993,461,168 bytes)

-- λ> length (divisoresCompuestos3 (product [1..11]))

-- 534

-- (7.35 secs, 3,993,461,336 bytes)

-- λ> length (divisoresCompuestos4 (product [1..11]))

-- 534

-- (0.07 secs, 110,126,392 bytes)

-- λ> length (divisoresCompuestos5 (product [1..11]))

-- 534

-- (0.01 secs, 3,332,224 bytes)

-- λ> length (divisoresCompuestos6 (product [1..11]))

-- 534

-- (0.01 secs, 1,869,776 bytes)

-- λ> length (divisoresCompuestos4 (product [1..14]))

-- 2585

-- (9.11 secs, 9,461,570,720 bytes)

-- λ> length (divisoresCompuestos5 (product [1..14]))

-- 2585

-- (0.04 secs, 17,139,872 bytes)

-- λ> length (divisoresCompuestos6 (product [1..14]))

-- 2585

-- (0.02 secs, 10,140,744 bytes)

-- λ> length (divisoresCompuestos2 (product [1..16]))

-- 5369

-- (1.97 secs, 932,433,176 bytes)

-- λ> length (divisoresCompuestos5 (product [1..16]))

-- 5369

-- (0.03 secs, 37,452,088 bytes)

-- λ> length (divisoresCompuestos6 (product [1..16]))

-- 5369

-- (0.03 secs, 23,017,480 bytes)

-- λ> length (divisoresCompuestos5 (product [1..25]))

-- 340022

-- (2.43 secs, 3,055,140,056 bytes)

-- λ> length (divisoresCompuestos6 (product [1..25]))

-- 340022

-- (1.94 secs, 2,145,440,904 bytes)

Pensamiento

«La verdad del hombre empieza donde acaba su propia tontería, pero la
tontería del hombre es inagotable.»

Antonio Machado

Árbol de divisores

PorJosé A. Alonso 21-diciembre-201828-diciembre-2018

Se dice que a es un divisor propio maximal de un número b si a es un divisor de b distinto de b y no existe ningún número c tal que a < c < b, a es un divisor de c y c es un divisor de b. Por ejemplo, 15 es un divisor propio maximal de 30, pero 5 no lo es.

El árbol de los divisores de un número x es el árbol que tiene como raíz el número x y cada nodo tiene como hijos sus divisores propios maximales. Por ejemplo, el árbol de divisores de 30 es

          30
          /|\
         / | \
        /  |  \
       /   |   \
      /    |    \
     6    10    15
    / \   / \   / \
   2   3 2   5 3   5

/|\

/ | \

6 10 15

/ \ / \ / \

2 3 2 5 3 5

Usando el tipo de dato

   data Arbol = N Integer [Arbol]
     deriving (Eq, Show)

1 2	data Arbol = N Integer [Arbol] deriving (Eq, Show)

el árbol anterior se representa por

   N 30
     [N 6
        [N 2 [N 1 []],
         N 3 [N 1 []]],
      N 10
        [N 2 [N 1 []],
         N 5 [N 1 []]],
      N 15
        [N 3 [N 1 []],
         N 5 [N 1 []]]]

N 30

[N 6

[N 2 [N 1 []],

N 3 [N 1 []]],

N 10

[N 2 [N 1 []],

N 5 [N 1 []]],

N 15

[N 3 [N 1 []],

N 5 [N 1 []]]]

Definir las funciones

   arbolDivisores             :: Integer -> Arbol
   nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

1 2	arbolDivisores :: Integer -> Arbol nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

tales que

(arbolDivisores x) es el árbol de los divisores del número x. Por ejemplo,

     λ> arbolDivisores 30
     N 30 [N 6  [N 2 [N 1 []],N 3 [N 1 []]],
           N 10 [N 2 [N 1 []],N 5 [N 1 []]],
           N 15 [N 3 [N 1 []],N 5 [N 1 []]]]

λ> arbolDivisores 30

N 30 [N 6 [N 2 [N 1 []],N 3 [N 1 []]],

N 10 [N 2 [N 1 []],N 5 [N 1 []]],

N 15 [N 3 [N 1 []],N 5 [N 1 []]]]

(nOcurrenciasArbolDivisores x y) es el número de veces que aparece el número x en el árbol de los divisores del número y. Por ejemplo,

     nOcurrenciasArbolDivisores  3 30  ==  2
     nOcurrenciasArbolDivisores  6 30  ==  1
     nOcurrenciasArbolDivisores 30 30  ==  1
     nOcurrenciasArbolDivisores  1 30  ==  6
     nOcurrenciasArbolDivisores  9 30  ==  0
     nOcurrenciasArbolDivisores  2 (product [1..10])  ==  360360
     nOcurrenciasArbolDivisores  3 (product [1..10])  ==  180180
     nOcurrenciasArbolDivisores  5 (product [1..10])  ==  90090
     nOcurrenciasArbolDivisores  7 (product [1..10])  ==  45045
     nOcurrenciasArbolDivisores  6 (product [1..10])  ==  102960
     nOcurrenciasArbolDivisores 10 (product [1..10])  ==  51480
     nOcurrenciasArbolDivisores 14 (product [1..10])  ==  25740

nOcurrenciasArbolDivisores 3 30 == 2

nOcurrenciasArbolDivisores 6 30 == 1

nOcurrenciasArbolDivisores 30 30 == 1

nOcurrenciasArbolDivisores 1 30 == 6

nOcurrenciasArbolDivisores 9 30 == 0

nOcurrenciasArbolDivisores 2 (product [1..10]) == 360360

nOcurrenciasArbolDivisores 3 (product [1..10]) == 180180

nOcurrenciasArbolDivisores 5 (product [1..10]) == 90090

nOcurrenciasArbolDivisores 7 (product [1..10]) == 45045

nOcurrenciasArbolDivisores 6 (product [1..10]) == 102960

nOcurrenciasArbolDivisores 10 (product [1..10]) == 51480

nOcurrenciasArbolDivisores 14 (product [1..10]) == 25740

Soluciones

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

data Arbol = N Integer [Arbol]
  deriving (Eq, Show)

-- Definición de arbolDivisores
-- ============================

arbolDivisores :: Integer -> Arbol
arbolDivisores x =
  N x (map arbolDivisores (divisoresPropiosMaximales x))

-- (divisoresPropiosMaximales x) es la lista de los divisores propios
-- maximales de x. Por ejemplo,
--    divisoresPropiosMaximales 30   ==  [6,10,15]
--    divisoresPropiosMaximales 420  ==  [60,84,140,210]
--    divisoresPropiosMaximales 7    ==  [1]
divisoresPropiosMaximales :: Integer -> [Integer]
divisoresPropiosMaximales x =
  reverse [x `div` y | y <- nub (primeFactors x)]

-- Definición de nOcurrenciasArbolDivisores
-- ========================================
  
nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer
nOcurrenciasArbolDivisores x y =
  nOcurrencias x (arbolDivisores y)

-- (nOcurrencias x a) es el número de veces que aprece x en el árbol
-- a. Por ejemplo,
--    nOcurrencias 3 (arbolDivisores 30)  ==  2
nOcurrencias :: Integer -> Arbol -> Integer
nOcurrencias x (N y [])
  | x == y    = 1
  | otherwise = 0
nOcurrencias x (N y zs)
  | x == y    = 1 + sum [nOcurrencias x z | z <- zs]
  | otherwise = sum [nOcurrencias x z | z <- zs]

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group, nub)

data Arbol = N Integer [Arbol]

deriving (Eq, Show)

-- Definición de arbolDivisores

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

arbolDivisores :: Integer -> Arbol

arbolDivisores x =

N x (map arbolDivisores (divisoresPropiosMaximales x))

-- (divisoresPropiosMaximales x) es la lista de los divisores propios

-- maximales de x. Por ejemplo,

-- divisoresPropiosMaximales 30 == [6,10,15]

-- divisoresPropiosMaximales 420 == [60,84,140,210]

-- divisoresPropiosMaximales 7 == [1]

divisoresPropiosMaximales :: Integer -> [Integer]

divisoresPropiosMaximales x =

reverse [x `div` y | y <- nub (primeFactors x)]

-- Definición de nOcurrenciasArbolDivisores

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

nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

nOcurrenciasArbolDivisores x y =

nOcurrencias x (arbolDivisores y)

-- (nOcurrencias x a) es el número de veces que aprece x en el árbol

-- a. Por ejemplo,

-- nOcurrencias 3 (arbolDivisores 30) == 2

nOcurrencias :: Integer -> Arbol -> Integer

nOcurrencias x (N y [])

| x == y = 1

| otherwise = 0

nOcurrencias x (N y zs)

| x == y = 1 + sum [nOcurrencias x z | z <- zs]

| otherwise = sum [nOcurrencias x z | z <- zs]

Pensamiento

«¿Dónde está la utilidad
de nuestras utilidades?
Volvamos a la verdad:
vanidad de vanidades.»

Antonio Machado

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico