Menu Close

Etiqueta: Recursión

Definición por recursión

Sucesiones sin progresiones aritméticas de longitud 3

Tres números x, y, z está en progresión aritmética (PA) si existe un d tal que y = x+d y z = y+d. Por ejemplo, 1, 3, 5 están en PA ya que 3 = 1+2 y 5 = 3+2.

Se considera la sucesión donde cada uno de sus términos es el número natural tal que no está en PA con cualesquiera dos términos anteriores de la sucesión. Por ejemplo, si representamos por f(n) el n-ésimo término de la sucesión, entonces

f(0) = 0, que es el menor número natural;
f(1) = 1, que es el menor número natural que no está en la sucesión; 
f(2) = 3, ya que [0, 1, 2] están en PA y
                 [0, 1, 3] no están en PA;
f(3) = 4, ya que [0, 1, 4], [0, 3, 4] y [1, 3, 4] no están en PA;
f(4) = 9, ya que se descartan
          + el 5 porque [1, 3, 5] están en PA
          + el 6 porque [0, 3, 6] están en PA
          + el 7 porque [1, 4, 7] están en PA
          + el 8 porque [0, 4, 8] estan en PA
          y se acepta el 9 porque no están en PA niguna de [0,1,9],
          [0,3,9], [0,4,9], [1,3,9], [1,4,9], [3,4,9].

Definir la sucesión

   sucesionSin3enPA :: [Integer]

donde cada uno de sus términos es el menor número natural tal que no está en PA con cualesquiera dos términos anteriores de la sucesión. Por ejemplo,

   λ> take 20 sucesionSin3enPA
   [0,1,3,4,9,10,12,13,27,28,30,31,36,37,39,40,81,82,84,85]
   λ> sucesionSin3enPA !! 250
   3270

Soluciones

import Data.List ((\\), delete, tails)
 
-- 1ª solución
-- ===========
 
sucesionSin3enPA :: [Integer]
sucesionSin3enPA = aux []  
  where aux xs = x : aux (x:xs)
          where x = head (noEnPAConDos xs)
 
noEnPAConDos :: [Integer] -> [Integer]
noEnPAConDos xs = [z | z <- [0..]
                   , z `notElem` xs
                   , and [z - y /= y - x | x <- xs
                                         , y <- dropWhile (<= x) xs]]
 
-- 2ª solución
-- ===========
 
-- Si x, y, z están en progresión aritmética, entonces
--    y = (x + z) / 2
-- Por tanto,
--    z = 2 * y - x
--
-- Teniendo en cuenta la relación auterior se define (aux xs ys) tal que
-- xs es la lista de los términos actuales de la sucesión e ys es la
-- lista de los números que no están en PA con cualesquieras dos de xs.
 
sucesionSin3enPA2 :: [Integer]
sucesionSin3enPA2 = aux [] [0..] 
  where
    aux xs (y:ys) = y : aux (y:xs) (ys \\ [2 * y - x | x <- xs])
 
-- 3º solución
-- ===========
 
sucesionSin3enPA3 :: [Integer]
sucesionSin3enPA3 = 0 : aux [1]
  where aux (x:xs) = x : aux (xs ++ [3*x,3*x+1])
 
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> sucesionSin3enPA !! 70
--    741
--    (7.97 secs, 5,444,053,240 bytes)
--    λ> sucesionSin3enPA2 !! 70
--    741
--    (0.03 secs, 35,781,952 bytes)
--    λ> sucesionSin3enPA3 !! 70
--    741
--    (0.01 secs, 192,864 bytes)
--    
--    λ> sucesionSin3enPA2 !! 350
--    7410
--    (9.46 secs, 10,119,851,016 bytes)
--    λ> sucesionSin3enPA3 !! 350
--    7410
--    (0.01 secs, 1,931,296 bytes)

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

Quien se vive se pierde, Abel decía.
¡Oh, distancia, distancia!, que la estrella
que nadie toca, guía.
¿Quién navegó sin ella?

Antonio Machado

Las conjeturas de Catalan y de Pillai

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

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

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

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]

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
  • (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]
  • (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]

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)]

Referencia

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

Codificación de Gödel

El Consejo Ejecutivo de la UNESCO ha proclamado el 14 de enero como Día mundial de la Lógica.

La fecha del 14 de enero se ha eligido para rendir homenaje a dos grandes lógicos del siglo XX: Kurt Gödel (que falleció el 14 de enero de 1978) y Alfred Tarski (que nació el 14 de enero de 1901).

Gödel demostró en 1931 los teoremas de incompletitud y para su demostración introdujo la actualmente conocida como codificación de Gödel que asigna a cada fórmula de un lenguaje formal un número único.

Dada una lista de números naturales xs, la codificación de Gödel de xs se obtiene multiplicando las potencias de los primos sucesivos, siendo los exponentes los sucesores de los elementos de xs. Por ejemplo, si xs es [6,0,4], la codificación de xs es

   2^(6+1) * 3^(0+1) * 5^(4+1) = 1200000

Definir las funciones

   codificaG   :: [Integer] -> Integer
   decodificaG :: Integer -> [Integer]

tales que

  • (codificaG xs) es la codificación de Gödel de xs. Por ejemplo,
     codificaG [6,0,4]            ==  1200000
     codificaG [3,1,1]            ==  3600
     codificaG [3,1,0,0,0,0,0,1]  ==  4423058640
     codificaG [1..6]             ==  126111168580452537982500
  • (decodificaG n) es la lista xs cuya codificación es n. Por ejemplo,
     decodificaG 1200000                   ==  [6,0,4]
     decodificaG 3600                      ==  [3,1,1]
     decodificaG 4423058640                ==  [3,1,0,0,0,0,0,1]
     decodificaG 126111168580452537982500  ==  [1,2,3,4,5,6]

Comprobar con QuickCheck que decodificaG es la inversa por la izquierda de codificaG; es decir, para toda lista xs de números enteros, se verifica que

   decodificaG (codificaG ys) == ys

donde ys es la lista de los valores absolutos de los elementos de xs.

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primes, primeFactors)
import Test.QuickCheck
 
codificaG   :: [Integer] -> Integer
codificaG xs = product [p^(x+1) | (p,x) <- zip primes xs] 
 
decodificaG :: Integer -> [Integer]
decodificaG n =
  [genericLength xs - 1 | xs <- group (primeFactors n)]
 
-- La propiedad es
propCodifica1 :: [Integer] -> Bool
propCodifica1 xs =
  decodificaG (codificaG ys) == ys
  where ys = map abs xs
 
-- La comprobación es
--    ghci> quickCheck propCodifica1
--    +++ OK, passed 100 tests.

Pensamiento

La verdad es la verdad, dígala Agamenón o su porquero.
– Agamenón: Conforme.
– El porquero: No me convence.

Antonio Machado

Teorema de Hilbert-Waring

El problema de Waring, propuesto por Edward Waring consiste en déterminar si, para cada número entero k mayor que 1, existe un número n tal que todo entero positivo se puede escribir como una suma de k-potencias de números positivos con n sumandos como máximo.

La respuesta afirmativa al problema, aportada por David Hilbert, se conoce como el teorema de Hilbert-Waring. Su enunciado es

Para cada número entero k, con k ≥ 2, existe un entero positivo g(k) tal que todo entero positivo se puede expresar como una suma de a lo más g(k) k-ésimas potencias.

Definir las funciones

   descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]
   orden :: Integer -> Integer -> Integer

tales que

  • (descomposiciones x k n) es la lista de descomposiciones de x como suma de n potencias con exponente k de números enteros positivos.
     descomposiciones 9   2 1  ==  [[9]]
     descomposiciones 9   3 1  ==  []
     descomposiciones 9   3 2  ==  [[1,8]]
     descomposiciones 9   4 9  ==  [[1,1,1,1,1,1,1,1,1]]
     descomposiciones 25  2 2  ==  [[9,16]]
     descomposiciones 133 2 3  ==  [[8,125]]
     descomposiciones 38  3 2  ==  [[1,1,36],[4,9,25]]
  • (orden x k) es el menor número de sumandos necesario para expresar x como suma de k-ésimas potencias. Por ejemplo,
     orden 9  2  ==  1
     orden 9  3  ==  2
     orden 9  4  ==  9
     orden 10 2  ==  2
     orden 10 3  ==  3
     orden 10 4  ==  10
     [maximum [orden x k | x <- [1..1000]] | k <- [1..6]] == [1,4,9,19,37,73]

Comprobar el teorema de Hilbert-Waring para k hasta 7; es decir, para todo número x positivo se verifica que

   orden x 2 <= 4   
   orden x 3 <= 9   
   orden x 4 <= 19  
   orden x 5 <= 37  
   orden x 6 <= 73  
   orden x 7 <= 143

y, en general,

   orden x k <= 2^k + floor ((3/2)^k) - 2

Soluciones

import Test.QuickCheck
 
descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]
descomposiciones x k n =
  sumas x (takeWhile (<= x) (potencias k)) n
 
-- (potencias n) es la lista de las potencias de n
--    take 7 (potencias 2)  ==  [1,4,9,16,25,36,49]
--    take 7 (potencias 3)  ==  [1,8,27,64,125,216,343]
potencias :: Integer -> [Integer]
potencias n = map (^n) [1..]
 
-- (sumas n ys x) es la lista de las descomposiciones de x como
-- sumas de n sumandos de la lista creciente ys. Por ejemplo,
--    sumas 3 [1,2] 2  ==  [[1,2]]
--    sumas 4 [1,2] 2  ==  [[2,2]]
--    sumas 5 [1,2] 2  ==  []
--    sumas 5 [1,2] 3  ==  [[1,2,2]]
--    sumas 6 [1,2] 3  ==  [[2,2,2]]
--    sumas 6 [1,2,5] 2  ==  [[1,5]]
sumas :: Integer -> [Integer] -> Integer -> [[Integer]]
sumas _ [] _                   = []
sumas x ys 1     | x `elem` ys = [[x]]
                 | otherwise   = []
sumas x (y:ys) n | y > x       = []
                 | otherwise   = map (y:) (sumas (x-y) (y:ys) (n-1)) ++
                                 sumas x ys n
 
orden :: Integer -> Integer -> Integer
orden x k = head [n | n <- [1..]
                    , not (null (descomposiciones x k n))]
 
-- El teorema es                                 
teorema_Hilbert_Waring :: Integer -> Integer -> Property
teorema_Hilbert_Waring x k =
  x > 0 && k >= 2
  ==>
  orden x 2 <= 4   &&
  orden x 3 <= 9   &&
  orden x 4 <= 19  &&
  orden x 5 <= 37  &&
  orden x 6 <= 73  &&
  orden x 7 <= 143 &&
  orden x k <= 2^k + floor ((3/2)^k) - 2
 
-- La comprobación es
--    λ> quickCheck teorema_Hilbert_Waring
--    +++ OK, passed 100 tests.

Referencia

Pensamiento

¡Y en la tersa arena,
cerca de la mar,
tu carne rosa y morena,
súbitamente Guiomar!

Antonio Machado

Factorizaciones de 4n+1

Sea S el conjunto

   S = {1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, ...}

de los enteros positivos congruentes con 1 módulo 4; es decir,

   S = {4n+1 | n ∈ N}

Un elemento n de S es irreducible si sólo es divisible por dos elementos de S: 1 y n. Por ejemplo, 9 es irreducible; pero 45 no lo es (ya que es el proctos de 5 y 9 que son elementos de S).

Definir las funciones

   esIrreducible :: Integer -> Bool
   factorizaciones :: Integer -> [[Integer]]
   conFactorizacionNoUnica :: [Integer]

tales que

  • (esIrreducible n) se verifica si n es irreducible. Por ejemplo,
     esIrreducible 9   ==  True
     esIrreducible 45  ==  False
  • (factorizaciones n) es la lista de conjuntos de elementos irreducibles de S cuyo producto es n. Por ejemplo,
     factorizaciones 9     ==  [[9]]
     factorizaciones 693   ==  [[9,77],[21,33]]
     factorizaciones 4389  ==  [[21,209],[33,133],[57,77]]
     factorizaciones 2205  ==  [[5,9,49],[5,21,21]]
  • conFactorizacionNoUnica es la lista de elementos de S cuya factorización no es única. Por ejemplo,
     λ> take 10 conFactorizacionNoUnica
     [441,693,1089,1197,1449,1617,1881,1953,2205,2277]

Soluciones

esIrreducible :: Integer -> Bool
esIrreducible n = divisores n == [1,n]
 
-- (divisores n) es el conjunto de elementos de S que dividen a n. Por
-- ejemplo, 
--    divisores 9    ==  [9]
--    divisores 693  ==  [9,21,33,77,693]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1,5..n], n `mod` x == 0] 
 
factorizaciones :: Integer -> [[Integer]]
factorizaciones 1 = [[1]]
factorizaciones n
  | esIrreducible n = [[n]]
  | otherwise       = [d:ds | d <- divisores n
                            , esIrreducible d
                            , ds@(e:_) <- factorizaciones (n `div` d)
                            , d <= e]
 
conFactorizacionNoUnica :: [Integer]
conFactorizacionNoUnica =
  [n | n <- [1,5..], length (factorizaciones n) > 1]

Pensamiento

¡Qué bien los nombres ponía
quien puso Sierra Morena
a esta serranía!

Antonio Machado