foldl1

Huecos de Aquiles

PorJosé A. Alonso 23-abril-202026-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)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Producto de Kronecker

PorJosé A. Alonso 28-febrero-20207-marzo-2020

Si $A$ es una matriz $m \times n$ y $B$ es una matriz $p \times q$ , entonces el producto de Kronecker $A \otimes B$ es la matriz bloque $mp \times nq$

Más explícitamente, tenemos

Por ejemplo,

Definir la función

   kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

1	kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

tal que (kronecker a b) es el producto de Kronecker de las matrices a y b. Por ejemplo,

   λ> kronecker (fromLists [[1,2],[3,1]]) (fromLists [[0,3],[2,1]])
   ┌         ┐
   │ 0 3 0 6 │
   │ 2 1 4 2 │
   │ 0 9 0 3 │
   │ 6 3 2 1 │
   └         ┘
   λ> kronecker (fromLists [[1,2],[3,4]]) (fromLists [[2,1],[-1,0],[3,2]])
   ┌             ┐
   │  2  1  4  2 │
   │ -1  0 -2  0 │
   │  3  2  6  4 │
   │  6  3  8  4 │
   │ -3  0 -4  0 │
   │  9  6 12  8 │
   └             ┘
   λ> kronecker (fromLists [[2,1],[-1,0],[3,2]]) (fromLists [[1,2],[3,4]])
   ┌             ┐
   │  2  4  1  2 │
   │  6  8  3  4 │
   │ -1 -2  0  0 │
   │ -3 -4  0  0 │
   │  3  6  2  4 │
   │  9 12  6  8 │
   └             ┘

λ> kronecker (fromLists [[1,2],[3,1]]) (fromLists [[0,3],[2,1]])

┌ ┐

│ 0 3 0 6 │

│ 2 1 4 2 │

│ 0 9 0 3 │

│ 6 3 2 1 │

└ ┘

λ> kronecker (fromLists [[1,2],[3,4]]) (fromLists [[2,1],[-1,0],[3,2]])

┌ ┐

│ 2 1 4 2 │

│ -1 0 -2 0 │

│ 3 2 6 4 │

│ 6 3 8 4 │

│ -3 0 -4 0 │

│ 9 6 12 8 │

└ ┘

λ> kronecker (fromLists [[2,1],[-1,0],[3,2]]) (fromLists [[1,2],[3,4]])

┌ ┐

│ 2 4 1 2 │

│ 6 8 3 4 │

│ -1 -2 0 0 │

│ -3 -4 0 0 │

│ 3 6 2 4 │

│ 9 12 6 8 │

└ ┘

Soluciones

import Data.Matrix

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

kronecker :: Num t => Matrix t -> Matrix t -> Matrix t
kronecker a b =
  matrix (m*p) (n*q) f
  where m = nrows a
        n = ncols a
        p = nrows b
        q = ncols b
        f (i,j) = a !(k+1,r+1) * b!(l+1,s+1)
          where (k,l) = quotRem (i-1) p
                (r,s) = quotRem (j-1) q

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

kronecker2 a b = bloqueFila a b (ncols a)
  where
    bloque (i,j) a b = scaleMatrix (a!(i,j)) b
    bloqueFila a b 1 = bloqueColumna 1 a b
    bloqueFila a b n = bloqueFila a b (n-1) <|> bloqueColumna n a b
    bloqueColumna j a b = aux a b (nrows a)
      where aux a b 1 = bloque (1,j) a b
            aux a b n = aux a b (n-1) <-> bloque (n,j) a b

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

kronecker3 :: Num t => Matrix t -> Matrix t -> Matrix t
kronecker3 a b =
  foldl1 (<->) [foldl1 (<|>) [scaleMatrix (a!(i,j)) b
                             | j <- [1..ncols b]]
                             | i <- [1..nrows a]]

import Data.Matrix

-- 1ª solución

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

kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

kronecker a b =

matrix (m*p) (n*q) f

where m = nrows a

n = ncols a

p = nrows b

q = ncols b

f (i,j) = a !(k+1,r+1) * b!(l+1,s+1)

where (k,l) = quotRem (i-1) p

(r,s) = quotRem (j-1) q

-- 2ª solución

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

kronecker2 a b = bloqueFila a b (ncols a)

where

bloque (i,j) a b = scaleMatrix (a!(i,j)) b

bloqueFila a b 1 = bloqueColumna 1 a b

bloqueFila a b n = bloqueFila a b (n-1) <|> bloqueColumna n a b

bloqueColumna j a b = aux a b (nrows a)

where aux a b 1 = bloque (1,j) a b

aux a b n = aux a b (n-1) <-> bloque (n,j) a b

-- 3ª solución

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

kronecker3 :: Num t => Matrix t -> Matrix t -> Matrix t

kronecker3 a b =

foldl1 (<->) [foldl1 (<|>) [scaleMatrix (a!(i,j)) b

| j <- [1..ncols b]]

| i <- [1..nrows a]]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La resolución de problemas es una habilidad práctica como, digamos, la natación. Adquirimos cualquier habilidad práctica por imitación y práctica. Tratando de nadar, imitas lo que otras personas hacen con sus manos y pies para mantener sus cabezas sobre el agua, y, finalmente, aprendes a nadar practicando la natación. Al intentar resolver problemas, hay que observar e imitar lo que hacen otras personas al resolver problemas y, finalmente, se aprende a resolver problemas haciéndolos.»

George Pólya.

Las conjeturas de Catalan y de Pillai

PorJosé A. Alonso 15-enero-202022-enero-2020

La conjetura de Catalan, enunciada en 1844 por Eugène Charles Catalan y demostrada 2002 por Preda Mihăilescu1, afirma que

Las únicas dos potencias de números enteros consecutivos son 8 y 9 (que son respectivamente 2³ y 3²).

En otras palabras, la única solución entera de la ecuación

   x^a - y^b = 1

1	x^a - y^b = 1

para x, a, y, b > 1 es x = 3, a = 2, y = 2, b = 3.

La conjetura de Pillai, propuesta por S.S. Pillai en 1942, generaliza este resultado y es un problema abierto. Afirma que cada entero se puede escribir sólo un número finito de veces como una diferencia de dos potencias perfectas. En otras palabras, para todo entero positivo n, el conjunto de soluciones de

   x^a - y^b = n

1	x^a - y^b = n

para x, a, y, b > 1 es finito.

Por ejemplo, para n = 4, hay 3 soluciones

   (2,3, 2,2) ya que 2³ -  2² =   8 -   4 = 4
   (6,2, 2,5) ya que 6² -  2⁵ =  36 -  32 = 4
   (5,3,11,2) ya que 5³ - 11² = 125 - 121 = 4

(2,3, 2,2) ya que 2³ - 2² = 8 - 4 = 4

(6,2, 2,5) ya que 6² - 2⁵ = 36 - 32 = 4

(5,3,11,2) ya que 5³ - 11² = 125 - 121 = 4

Las soluciones se pueden representar por la menor potencia (en el caso anterior, por 4, 32 y 121) ya que dado n (en el caso anterior es 4), la potencia mayor es la menor más n.

Definir las funciones

   potenciasPerfectas :: [Integer]
   solucionesPillati :: Integer -> [Integer]
   solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

potenciasPerfectas :: [Integer]

solucionesPillati :: Integer -> [Integer]

solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

tales que

potenciasPerfectas es la lista de las potencias perfectas (es decir, de los números de la forma x^a con x y a mayores que 1). Por ejemplo,

     take 10 potenciasPerfectas  ==  [4,8,9,16,25,27,32,36,49,64]
     potenciasPerfectas !! 200   ==  28224

1 2	take 10 potenciasPerfectas == [4,8,9,16,25,27,32,36,49,64] potenciasPerfectas !! 200 == 28224

(solucionesPillati n) es la lista de las menores potencias de las soluciones de la ecuación de Pillati x^a – y^b = n; es decir, es la lista de los u tales que u y u+n son potencias perfectas. Por ejemplo,

     take 3 (solucionesPillati 4)  ==  [4,32,121]
     take 2 (solucionesPillati 5)  ==  [4,27]
     take 4 (solucionesPillati 7)  ==  [9,25,121,32761]

take 3 (solucionesPillati 4) == [4,32,121]

take 2 (solucionesPillati 5) == [4,27]

take 4 (solucionesPillati 7) == [9,25,121,32761]

(solucionesPillatiAcotadas c n) es la lista de elementos de (solucionesPillati n) menores que n. Por ejemplo,

     solucionesPillatiAcotadas (10^3) 1  ==  [8]
     solucionesPillatiAcotadas (10^3) 2  ==  [25]
     solucionesPillatiAcotadas (10^3) 3  ==  [125]
     solucionesPillatiAcotadas (10^3) 4  ==  [4,32,121]
     solucionesPillatiAcotadas (10^3) 5  ==  [4,27]
     solucionesPillatiAcotadas (10^3) 6  ==  []
     solucionesPillatiAcotadas (10^3) 7  ==  [9,25,121]
     solucionesPillatiAcotadas (10^5) 7  ==  [9,25,121,32761]

solucionesPillatiAcotadas (10^3) 1 == [8]

solucionesPillatiAcotadas (10^3) 2 == [25]

solucionesPillatiAcotadas (10^3) 3 == [125]

solucionesPillatiAcotadas (10^3) 4 == [4,32,121]

solucionesPillatiAcotadas (10^3) 5 == [4,27]

solucionesPillatiAcotadas (10^3) 6 == []

solucionesPillatiAcotadas (10^3) 7 == [9,25,121]

solucionesPillatiAcotadas (10^5) 7 == [9,25,121,32761]

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)

-- Definiciones de potenciasPerfectas
-- ==================================

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

potenciasPerfectas1 :: [Integer]
potenciasPerfectas1 = filter esPotenciaPerfecta [4..]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta = not . null. potenciasPerfectasDe 

-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que 
-- x = a^b. Por ejemplo,
--    potenciasPerfectasDe 64  ==  [(2,6),(4,3),(8,2)]
--    potenciasPerfectasDe 72  ==  []
potenciasPerfectasDe :: Integer -> [(Integer,Integer)]
potenciasPerfectasDe n = 
    [(m,k) | m <- takeWhile (\x -> x*x <= n) [2..]
           , k <- takeWhile (\x -> m^x <= n) [2..]
           , m^k == n]

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

potenciasPerfectas2 :: [Integer]
potenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]

-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta2 36  ==  True
--    esPotenciaPerfecta2 72  ==  False
esPotenciaPerfecta2 :: Integer -> Bool
esPotenciaPerfecta2 x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de l factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Int]
exponentes x = [length ys | ys <- group (primeFactors x)] 

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

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

potenciasPerfectas3 :: [Integer]
potenciasPerfectas3 = mezclaTodas potencias

-- potencias es la lista las listas de potencias de todos los números
-- mayores que 1 con exponentes mayores que 1. Por ejemplo,
--    λ> map (take 3) (take 4 potencias)
--    [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]
potencias :: [[Integer]]
potencias = [[n^k | k <- [2..]] | n <- [2..]]

-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xss. Por ejemplo,
--    take 7 (mezclaTodas potencias)  ==  [4,8,9,16,25,27,32]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xs e ys. Por ejemplo,
--    take 7 (mezcla [2,5..] [4,6..])  ==  [2,4,5,6,8,10,11]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys

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

--    λ> potenciasPerfectas1 !! 200
--    28224
--    (7.24 secs, 9,245,991,160 bytes)
--    λ> potenciasPerfectas2 !! 200
--    28224
--    (0.30 secs, 814,597,152 bytes)
--    λ> potenciasPerfectas3 !! 200
--    28224
--    (0.01 secs, 7,061,120 bytes)

-- En lo que sigue se usa la 3ª definición
potenciasPerfectas :: [Integer]
potenciasPerfectas = potenciasPerfectas3

-- Definición de solucionesPillati
-- ===============================

solucionesPillati :: Integer -> [Integer]
solucionesPillati n =
  [x | x <- potenciasPerfectas
     , esPotenciaPerfecta2 (x+n)]

-- Definición de solucionesPillatiAcotadas
-- =======================================

solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]
solucionesPillatiAcotadas c n =
  [x | x <- takeWhile (< (c-n)) potenciasPerfectas
     , esPotenciaPerfecta2 (x+n)]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

-- Definiciones de potenciasPerfectas

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

-- 1ª definición

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

potenciasPerfectas1 :: [Integer]

potenciasPerfectas1 = filter esPotenciaPerfecta [4..]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta 36 == True

-- esPotenciaPerfecta 72 == False

esPotenciaPerfecta :: Integer -> Bool

esPotenciaPerfecta = not . null. potenciasPerfectasDe

-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que

-- x = a^b. Por ejemplo,

-- potenciasPerfectasDe 64 == [(2,6),(4,3),(8,2)]

-- potenciasPerfectasDe 72 == []

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

potenciasPerfectasDe n =

[(m,k) | m <- takeWhile (\x -> x*x <= n) [2..]

, k <- takeWhile (\x -> m^x <= n) [2..]

, m^k == n]

-- 2ª definición

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

potenciasPerfectas2 :: [Integer]

potenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]

-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta2 36 == True

-- esPotenciaPerfecta2 72 == False

esPotenciaPerfecta2 :: Integer -> Bool

esPotenciaPerfecta2 x = mcd (exponentes x) > 1

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

-- de x. Por ejemplos,

-- exponentes 36 == [2,2]

-- exponentes 72 == [3,2]

exponentes :: Integer -> [Int]

exponentes x = [length ys | ys <- group (primeFactors x)]

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

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

-- mcd [4,5,10] == 1

mcd :: [Int] -> Int

mcd = foldl1 gcd

-- 3ª definición

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

potenciasPerfectas3 :: [Integer]

potenciasPerfectas3 = mezclaTodas potencias

-- potencias es la lista las listas de potencias de todos los números

-- mayores que 1 con exponentes mayores que 1. Por ejemplo,

-- λ> map (take 3) (take 4 potencias)

-- [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]

potencias :: [[Integer]]

potencias = [[n^k | k <- [2..]] | n <- [2..]]

-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las

-- listas ordenadas xss. Por ejemplo,

-- take 7 (mezclaTodas potencias) == [4,8,9,16,25,27,32]

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las

-- listas ordenadas xs e ys. Por ejemplo,

-- take 7 (mezcla [2,5..] [4,6..]) == [2,4,5,6,8,10,11]

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

mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)

| x == y = x : mezcla xs ys

| x > y = y : mezcla (x:xs) ys

-- Comparación de eficiencia

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

-- λ> potenciasPerfectas1 !! 200

-- 28224

-- (7.24 secs, 9,245,991,160 bytes)

-- λ> potenciasPerfectas2 !! 200

-- 28224

-- (0.30 secs, 814,597,152 bytes)

-- λ> potenciasPerfectas3 !! 200

-- 28224

-- (0.01 secs, 7,061,120 bytes)

-- En lo que sigue se usa la 3ª definición

potenciasPerfectas :: [Integer]

potenciasPerfectas = potenciasPerfectas3

-- Definición de solucionesPillati

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

solucionesPillati :: Integer -> [Integer]

solucionesPillati n =

[x | x <- potenciasPerfectas

, esPotenciaPerfecta2 (x+n)]

-- Definición de solucionesPillatiAcotadas

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

solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

solucionesPillatiAcotadas c n =

[x | x <- takeWhile (< (c-n)) potenciasPerfectas

, esPotenciaPerfecta2 (x+n)]

Referencia

Catalan’s conjecture en Wikipedia.

Pensamiento

Y te enviaré mi canción:
«Se canta lo que se pierde»,
con un papagayo verde
que la diga en tu balcón.

Antonio Machado

Intersección de listas infinitas crecientes

PorJosé A. Alonso 17-diciembre-201924-diciembre-2019

Definir la función

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

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

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

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

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

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

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

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

Soluciones

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

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

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

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

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

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

interseccion3 :: Ord a => [[a]] -> [a]
interseccion3 (xs:xss) =
  [x | x <- xs, all (x `pertenece`) xss]
 
pertenece :: Ord a => a -> [a] -> Bool
pertenece x xs = x == head (dropWhile (<x) xs)

-- 1ª solución

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

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

interseccion [xs] = xs

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

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

interseccionDos (x:xs) (y:ys)

| x == y = x : interseccionDos xs ys

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

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

-- 2ª solución

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

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

interseccion2 = foldl1 interseccionDos

-- 3ª solución

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

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

interseccion3 (xs:xss) =

[x | x <- xs, all (x `pertenece`) xss]

pertenece :: Ord a => a -> [a] -> Bool

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

Pensamiento

Dios no es el creador del mundo (según Martín), sino el creador de la nada.

Antonio Machado

Menor divisible por todos

PorJosé A. Alonso 28-noviembre-20195-diciembre-2019

Definir la función

   menorDivisible :: Integer -> Integer -> Integer

1	menorDivisible :: Integer -> Integer -> Integer

tal que (menorDivisible a b) es el menor número divisible por todos los números desde a hasta b, ambos inclusive. Por ejemplo,

   menorDivisible 1 10                        ==  2520
   length (show (menorDivisible 1 (3*10^5)))  ==  130141

1 2	menorDivisible 1 10 == 2520 length (show (menorDivisible 1 (3*10^5))) == 130141

Nota: Este ejercicio está basado en el problema 5 del Proyecto Euler

Soluciones

import Data.List (foldl')

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

menorDivisible :: Integer -> Integer -> Integer
menorDivisible a b =
  head [x | x <- [b..]
          , and [x `mod` y == 0 | y <- [a..b]]]

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

menorDivisible2 :: Integer -> Integer -> Integer
menorDivisible2 a b  
  | a == b    = a
  | otherwise = lcm a (menorDivisible (a+1) b)

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

menorDivisible3 :: Integer -> Integer -> Integer
menorDivisible3 a b = foldl lcm 1 [a..b] 

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

menorDivisible4 :: Integer -> Integer -> Integer
menorDivisible4 a b = foldl1 lcm [a..b] 

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

menorDivisible5 :: Integer -> Integer -> Integer
menorDivisible5 a b = foldl' lcm 1 [a..b] 

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

menorDivisible6 :: Integer -> Integer -> Integer
menorDivisible6 a b = foldr1 lcm [a..b] 

-- 7ª solución
-- ===========

menorDivisible7 :: Integer -> Integer -> Integer
menorDivisible7 a = foldr1 lcm . enumFromTo a

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

--   λ> menorDivisible 1 17
--   12252240
--   (18.63 secs, 15,789,475,488 bytes)
--   λ> menorDivisible2 1 17
--   12252240
--   (13.29 secs, 11,868,764,272 bytes)
--   λ> menorDivisible3 1 17
--   12252240
--   (0.00 secs, 114,688 bytes)
--   λ> menorDivisible4 1 17
--   12252240
--   (0.01 secs, 114,752 bytes)
--   λ> menorDivisible5 1 17
--   12252240
--   (0.01 secs, 110,640 bytes)
--   λ> menorDivisible6 1 17
--   12252240
--   (0.01 secs, 114,752 bytes)
--   λ> menorDivisible7 1 17
--   12252240
--   (0.00 secs, 110,912 bytes)
--   
--   λ> length (show (menorDivisible3 1 (10^5)))
--   43452
--   (1.54 secs, 2,021,887,000 bytes)
--   λ> length (show (menorDivisible4 1 (10^5)))
--   43452
--   (1.47 secs, 2,021,886,616 bytes)
--   λ> length (show (menorDivisible5 1 (10^5)))
--   43452
--   (0.65 secs, 2,009,595,568 bytes)
--   λ> length (show (menorDivisible6 1 (10^5)))
--   43452
--   (0.30 secs, 172,986,840 bytes)
--   λ> length (show (menorDivisible7 1 (10^5)))
--   43452
--   (0.30 secs, 172,986,920 bytes)
--   
--   λ> length (show (menorDivisible5 1 (2*10^5)))
--   86871
--   (2.47 secs, 7,989,147,304 bytes)
--   λ> length (show (menorDivisible6 1 (2*10^5)))
--   86871
--   (0.89 secs, 533,876,496 bytes)
--   λ> length (show (menorDivisible7 1 (2*10^5)))
--   86871
--   (0.88 secs, 533,875,608 bytes)

import Data.List (foldl')

-- 1ª solución

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

menorDivisible :: Integer -> Integer -> Integer

menorDivisible a b =

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

, and [x `mod` y == 0 | y <- [a..b]]]

-- 2ª solución

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

menorDivisible2 :: Integer -> Integer -> Integer

menorDivisible2 a b

| a == b = a

| otherwise = lcm a (menorDivisible (a+1) b)

-- 3ª solución

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

menorDivisible3 :: Integer -> Integer -> Integer

menorDivisible3 a b = foldl lcm 1 [a..b]

-- 4ª solución

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

menorDivisible4 :: Integer -> Integer -> Integer

menorDivisible4 a b = foldl1 lcm [a..b]

-- 5ª solución

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

menorDivisible5 :: Integer -> Integer -> Integer

menorDivisible5 a b = foldl' lcm 1 [a..b]

-- 6ª solución

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

menorDivisible6 :: Integer -> Integer -> Integer

menorDivisible6 a b = foldr1 lcm [a..b]

-- 7ª solución

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

menorDivisible7 :: Integer -> Integer -> Integer

menorDivisible7 a = foldr1 lcm . enumFromTo a

-- Comparación de eficiencia

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

-- λ> menorDivisible 1 17

-- 12252240

-- (18.63 secs, 15,789,475,488 bytes)

-- λ> menorDivisible2 1 17

-- 12252240

-- (13.29 secs, 11,868,764,272 bytes)

-- λ> menorDivisible3 1 17

-- 12252240

-- (0.00 secs, 114,688 bytes)

-- λ> menorDivisible4 1 17

-- 12252240

-- (0.01 secs, 114,752 bytes)

-- λ> menorDivisible5 1 17

-- 12252240

-- (0.01 secs, 110,640 bytes)

-- λ> menorDivisible6 1 17

-- 12252240

-- (0.01 secs, 114,752 bytes)

-- λ> menorDivisible7 1 17

-- 12252240

-- (0.00 secs, 110,912 bytes)

-- λ> length (show (menorDivisible3 1 (10^5)))

-- 43452

-- (1.54 secs, 2,021,887,000 bytes)

-- λ> length (show (menorDivisible4 1 (10^5)))

-- 43452

-- (1.47 secs, 2,021,886,616 bytes)

-- λ> length (show (menorDivisible5 1 (10^5)))

-- 43452

-- (0.65 secs, 2,009,595,568 bytes)

-- λ> length (show (menorDivisible6 1 (10^5)))

-- 43452

-- (0.30 secs, 172,986,840 bytes)

-- λ> length (show (menorDivisible7 1 (10^5)))

-- 43452

-- (0.30 secs, 172,986,920 bytes)

-- λ> length (show (menorDivisible5 1 (2*10^5)))

-- 86871

-- (2.47 secs, 7,989,147,304 bytes)

-- λ> length (show (menorDivisible6 1 (2*10^5)))

-- 86871

-- (0.89 secs, 533,876,496 bytes)

-- λ> length (show (menorDivisible7 1 (2*10^5)))

-- 86871

-- (0.88 secs, 533,875,608 bytes)

Pensamiento

Será el peor de los malos
bribón que olvide
su vocación de diablo.

Antonio Machado

Huecos de Aquiles

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

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

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

Intersección de listas infinitas crecientes

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

Definir la función

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

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

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

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

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

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

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

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

Soluciones

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

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

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

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

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

-- 1ª solución

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

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

interseccion [xs] = xs

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

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

interseccionDos (x:xs) (y:ys)

| x == y = x : interseccionDos xs ys

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

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

-- 2ª solución

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

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

interseccion2 = foldl1 interseccionDos

Pensamiento

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

Antonio Machado

Entre dos conjuntos

PorJosé A. Alonso 12-diciembre-201817-enero-2019

Se dice que un x número se encuentra entre dos conjuntos xs e ys si x es divisible por todos los elementos de xs y todos los elementos de zs son divisibles por x. Por ejemplo, 12 se encuentra entre los conjuntos {2, 6} y {24, 36}.

Definir la función

   entreDosConjuntos :: [Int] -> [Int] -> [Int]

1	entreDosConjuntos :: [Int] -> [Int] -> [Int]

tal que (entreDosConjuntos xs ys) es la lista de elementos entre xs e ys (se supone que xs e ys son listas no vacías de números enteros positivos). Por ejemplo,

   entreDosConjuntos [2,6] [24,36]     ==  [6,12]
   entreDosConjuntos [2,4] [32,16,96]  ==  [4,8,16]

1 2	entreDosConjuntos [2,6] [24,36] == [6,12] entreDosConjuntos [2,4] [32,16,96] == [4,8,16]

Otros ejemplos

   λ> (xs,a) = ([1..15],product xs) 
   λ> length (entreDosConjuntos5 xs [a,2*a..10*a])
   270
   λ> (xs,a) = ([1..16],product xs) 
   λ> length (entreDosConjuntos5 xs [a,2*a..10*a])
   360

λ> (xs,a) = ([1..15],product xs)

λ> length (entreDosConjuntos5 xs [a,2*a..10*a])

270

λ> (xs,a) = ([1..16],product xs)

λ> length (entreDosConjuntos5 xs [a,2*a..10*a])

360

Soluciones

import Test.QuickCheck 

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

entreDosConjuntos :: [Int] -> [Int] -> [Int]
entreDosConjuntos xs ys =
  [z | z <- [a..b]
     , and [z `mod` x == 0 | x <- xs]
     , and [y `mod` z == 0 | y <- ys]]
  where a = maximum xs
        b = minimum ys

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

entreDosConjuntos2 :: [Int] -> [Int] -> [Int]
entreDosConjuntos2 xs ys =
  [z | z <- [a..b]
     , all (`divideA` z) xs
     , all (z `divideA`) ys]
  where a = mcmL xs
        b = mcdL ys

--    mcmL [2,3,18]  ==  18
--    mcmL [2,3,15]  ==  30
mcdL :: [Int] -> Int
mcdL [x]    = x
mcdL (x:xs) = gcd x (mcdL xs)

--    mcmL [12,30,18]  ==  6
--    mcmL [12,30,14]  ==  2
mcmL :: [Int] -> Int
mcmL [x]    = x
mcmL (x:xs) = lcm x (mcmL xs)

divideA :: Int -> Int -> Bool
divideA x y = y `mod` x == 0

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

entreDosConjuntos3 :: [Int] -> [Int] -> [Int]
entreDosConjuntos3 xs ys =
  [z | z <- [a..b]
     , all (`divideA` z) xs
     , all (z `divideA`) ys]
  where a = mcmL2 xs
        b = mcdL2 ys

-- Definición equivalente
mcdL2 :: [Int] -> Int
mcdL2 = foldl1 gcd

-- Definición equivalente
mcmL2 :: [Int] -> Int
mcmL2 = foldl1 lcm

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

entreDosConjuntos4 :: [Int] -> [Int] -> [Int]
entreDosConjuntos4 xs ys =
  [z | z <- [a,a+a..b]
     , z `divideA` b] 
  where a = mcmL2 xs
        b = mcdL2 ys

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

entreDosConjuntos5 :: [Int] -> [Int] -> [Int]
entreDosConjuntos5 xs ys =
  filter (`divideA` b) [a,a+a..b]
  where a = mcmL2 xs
        b = mcdL2 ys

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

-- Para comprobar la equivalencia se define el tipo de listas no vacías
-- de números enteros positivos:
newtype ListaNoVaciaDePositivos = L [Int]
  deriving Show

-- genListaNoVaciaDePositivos es un generador de listas no vacióas de
-- enteros positivos. Por ejemplo,
--    λ> sample genListaNoVaciaDePositivos
--    L [1]
--    L [1,2,2]
--    L [4,3,4]
--    L [1,6,5,2,4]
--    L [2,8]
--    L [11]
--    L [13,2,3]
--    L [7,3,9,15,11,12,13,3,9,6,13,3]
--    L [16,2,11,10,6,5,16,4,1,15,9,11,8,15,2,15,7]
--    L [5,4,9,13,5,6,7]
--    L [7,4,6,12,2,11,6,14,14,13,14,11,6,2,18,8,16,2,13,9]
genListaNoVaciaDePositivos :: Gen ListaNoVaciaDePositivos
genListaNoVaciaDePositivos = do
  x  <- arbitrary
  xs <- arbitrary
  return (L (map ((+1) . abs) (x:xs)))

-- Generación arbitraria de listas no vacías de enteros positivos.
instance Arbitrary ListaNoVaciaDePositivos where
  arbitrary = genListaNoVaciaDePositivos

-- La propiedad es
prop_entreDosConjuntos_equiv ::
     ListaNoVaciaDePositivos
  -> ListaNoVaciaDePositivos
  -> Bool
prop_entreDosConjuntos_equiv (L xs) (L ys) =
  entreDosConjuntos xs ys == entreDosConjuntos2 xs ys &&
  entreDosConjuntos xs ys == entreDosConjuntos3 xs ys &&
  entreDosConjuntos xs ys == entreDosConjuntos4 xs ys &&
  entreDosConjuntos xs ys == entreDosConjuntos5 xs ys 

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

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

--    λ> (xs,a) = ([1..10],product xs) 
--    λ> length (entreDosConjuntos xs [a,2*a..10*a])
--    36
--    (5.08 secs, 4,035,689,200 bytes)
--    λ> length (entreDosConjuntos2 xs [a,2*a..10*a])
--    36
--    (3.75 secs, 2,471,534,072 bytes)
--    λ> length (entreDosConjuntos3 xs [a,2*a..10*a])
--    36
--    (3.73 secs, 2,471,528,664 bytes)
--    λ> length (entreDosConjuntos4 xs [a,2*a..10*a])
--    36
--    (0.01 secs, 442,152 bytes)
--    λ> length (entreDosConjuntos5 xs [a,2*a..10*a])
--    36
--    (0.00 secs, 374,824 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

import Test.QuickCheck

-- 1ª solución

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

entreDosConjuntos :: [Int] -> [Int] -> [Int]

entreDosConjuntos xs ys =

[z | z <- [a..b]

, and [z `mod` x == 0 | x <- xs]

, and [y `mod` z == 0 | y <- ys]]

where a = maximum xs

b = minimum ys

-- 2ª solución

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

entreDosConjuntos2 :: [Int] -> [Int] -> [Int]

entreDosConjuntos2 xs ys =

[z | z <- [a..b]

, all (`divideA` z) xs

, all (z `divideA`) ys]

where a = mcmL xs

b = mcdL ys

-- mcmL [2,3,18] == 18

-- mcmL [2,3,15] == 30

mcdL :: [Int] -> Int

mcdL [x] = x

mcdL (x:xs) = gcd x (mcdL xs)

-- mcmL [12,30,18] == 6

-- mcmL [12,30,14] == 2

mcmL :: [Int] -> Int

mcmL [x] = x

mcmL (x:xs) = lcm x (mcmL xs)

divideA :: Int -> Int -> Bool

divideA x y = y `mod` x == 0

-- 3ª solución

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

entreDosConjuntos3 :: [Int] -> [Int] -> [Int]

entreDosConjuntos3 xs ys =

[z | z <- [a..b]

, all (`divideA` z) xs

, all (z `divideA`) ys]

where a = mcmL2 xs

b = mcdL2 ys

-- Definición equivalente

mcdL2 :: [Int] -> Int

mcdL2 = foldl1 gcd

-- Definición equivalente

mcmL2 :: [Int] -> Int

mcmL2 = foldl1 lcm

-- 4ª solución

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

entreDosConjuntos4 :: [Int] -> [Int] -> [Int]

entreDosConjuntos4 xs ys =

[z | z <- [a,a+a..b]

, z `divideA` b]

where a = mcmL2 xs

b = mcdL2 ys

-- 5ª solución

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

entreDosConjuntos5 :: [Int] -> [Int] -> [Int]

entreDosConjuntos5 xs ys =

filter (`divideA` b) [a,a+a..b]

where a = mcmL2 xs

b = mcdL2 ys

-- Equivalencia

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

-- Para comprobar la equivalencia se define el tipo de listas no vacías

-- de números enteros positivos:

newtype ListaNoVaciaDePositivos = L [Int]

deriving Show

-- genListaNoVaciaDePositivos es un generador de listas no vacióas de

-- enteros positivos. Por ejemplo,

-- λ> sample genListaNoVaciaDePositivos

-- L [1]

-- L [1,2,2]

-- L [4,3,4]

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

-- L [2,8]

-- L [11]

-- L [13,2,3]

-- L [7,3,9,15,11,12,13,3,9,6,13,3]

-- L [16,2,11,10,6,5,16,4,1,15,9,11,8,15,2,15,7]

-- L [5,4,9,13,5,6,7]

-- L [7,4,6,12,2,11,6,14,14,13,14,11,6,2,18,8,16,2,13,9]

genListaNoVaciaDePositivos :: Gen ListaNoVaciaDePositivos

genListaNoVaciaDePositivos = do

x <- arbitrary

xs <- arbitrary

return (L (map ((+1) . abs) (x:xs)))

-- Generación arbitraria de listas no vacías de enteros positivos.

instance Arbitrary ListaNoVaciaDePositivos where

arbitrary = genListaNoVaciaDePositivos

-- La propiedad es

prop_entreDosConjuntos_equiv ::

ListaNoVaciaDePositivos

-> ListaNoVaciaDePositivos

-> Bool

prop_entreDosConjuntos_equiv (L xs) (L ys) =

entreDosConjuntos xs ys == entreDosConjuntos2 xs ys &&

entreDosConjuntos xs ys == entreDosConjuntos3 xs ys &&

entreDosConjuntos xs ys == entreDosConjuntos4 xs ys &&

entreDosConjuntos xs ys == entreDosConjuntos5 xs ys

-- La comprobación es

-- λ> quickCheck prop_entreDosConjuntos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> (xs,a) = ([1..10],product xs)

-- λ> length (entreDosConjuntos xs [a,2*a..10*a])

-- 36

-- (5.08 secs, 4,035,689,200 bytes)

-- λ> length (entreDosConjuntos2 xs [a,2*a..10*a])

-- 36

-- (3.75 secs, 2,471,534,072 bytes)

-- λ> length (entreDosConjuntos3 xs [a,2*a..10*a])

-- 36

-- (3.73 secs, 2,471,528,664 bytes)

-- λ> length (entreDosConjuntos4 xs [a,2*a..10*a])

-- 36

-- (0.01 secs, 442,152 bytes)

-- λ> length (entreDosConjuntos5 xs [a,2*a..10*a])

-- 36

-- (0.00 secs, 374,824 bytes)

Referencia

Este ejercicio está basado en el problema Between two sets de HackerRank.

Pensamiento

Las razones no se transmiten, se engendran, por cooperación, en el diálogo.

Antonio Machado

Complemento potencial

PorJosé A. Alonso 22-enero-201829-enero-2018

El complemento potencial de un número entero positivo x es el menor número y tal que el producto de x por y es un una potencia perfecta. Por ejemplo,

el complemento potencial de 12 es 3 ya que 12 y 24 no son potencias perfectas pero 36 sí lo es;
el complemento potencial de 54 es 4 ya que 54, 108 y 162 no son potencias perfectas pero 216 = 6^3 sí lo es.

Definir las funciones

   complemento                 :: Integer -> Integer
   graficaComplementoPotencial :: Integer -> IO ()

1 2	complemento :: Integer -> Integer graficaComplementoPotencial :: Integer -> IO ()

tales que

(complemento x) es el complemento potencial de x; por ejemplo,

     complemento 12     ==  3
     complemento 54     ==  4
     complemento 720    ==  5
     complemento 24000  ==  9
     complemento 2018   ==  2018

complemento 12 == 3

complemento 54 == 4

complemento 720 == 5

complemento 24000 == 9

complemento 2018 == 2018

(graficaComplementoPotencial n) dibuja la gráfica de los complementos potenciales de los n primeros números enteros positivos. Por ejemplo, (graficaComplementoPotencial 100) dibuja

y (graficaComplementoPotencial 500) dibuja

Comprobar con QuickCheck que (complemento x) es menor o igual que x.

Soluciones

import Data.Numbers.Primes     (primeFactors)
import Data.List               (genericLength, group)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG, Title))
import Test.QuickCheck

complemento :: Integer -> Integer
complemento 1 = 1
complemento x =
  head [y | y <- [1..]
          , esPotenciaPerfecta (x*y)]
  
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Integer]
exponentes = map snd . factorizacion
  
-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

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

-- La propiedad es
prop_complemento :: (Positive Integer) -> Bool
prop_complemento (Positive x) =
  complemento x <= x

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

graficaComplementoPotencial :: Integer -> IO ()
graficaComplementoPotencial n =
  plotList [Key Nothing
           , PNG ("Complemento_potencial_"  ++ show n ++ ".png")
           , Title ("(graficaComplementoPotencial " ++ show n ++ ")") 
           ]
           (map complemento [1..n])

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

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

import Test.QuickCheck

complemento :: Integer -> Integer

complemento 1 = 1

complemento x =

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

, esPotenciaPerfecta (x*y)]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta 36 == True

-- esPotenciaPerfecta 72 == False

esPotenciaPerfecta :: Integer -> Bool

esPotenciaPerfecta x = mcd (exponentes x) > 1

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

-- de x. Por ejemplos,

-- exponentes 36 == [2,2]

-- exponentes 72 == [3,2]

exponentes :: Integer -> [Integer]

exponentes = map snd . factorizacion

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

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

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

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

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

-- mcd [4,5,10] == 1

mcd :: [Integer] -> Integer

mcd = foldl1 gcd

-- La propiedad es

prop_complemento :: (Positive Integer) -> Bool

prop_complemento (Positive x) =

complemento x <= x

-- La comprobación es

-- λ> quickCheck prop_complemento

-- +++ OK, passed 100 tests.

graficaComplementoPotencial :: Integer -> IO ()

graficaComplementoPotencial n =

plotList [Key Nothing

, PNG ("Complemento_potencial_" ++ show n ++ ".png")

, Title ("(graficaComplementoPotencial " ++ show n ++ ")")

]

(map complemento [1..n])

Producto de Kronecker

Soluciones

Otras soluciones

Pensamiento

Intersección de listas infinitas crecientes

Soluciones

Pensamiento

Menor divisible por todos

Soluciones

Pensamiento

Subconjuntos divisibles

Soluciones

Pensamiento

Intersección de listas infinitas crecientes

Soluciones

Pensamiento

Entre dos conjuntos

Soluciones

Referencia

Pensamiento

Entradas recientes

Buscar

Correo electrónico