Comprensión – Página 16

Ordenación por frecuencia

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

Definir la función

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

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

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

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

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

Soluciones

import Data.List (group, sort)

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

import Data.List (group, sort)

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

ordPorFrecuencia xs =

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

Sumas digitales de primos consecutivos

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

Definir la función

   primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

1	primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

tal que (primosConsecutivosConSumasDigitalesPrimas k) es la sucesión de listas de k primos consecutivos tales que las sumas ordenadas de sus dígitos también son primos consecutivos. Por ejemplo,

   λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 2)
   [[2,3],[3,5],[5,7],[41,43],[43,47]]
   λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 3)
   [[2,3,5],[3,5,7],[41,43,47],[191,193,197],[193,197,199]]
   λ> take 4 (primosConsecutivosConSumasDigitalesPrimas 4)
   [[2,3,5,7],[3,5,7,11],[191,193,197,199],[821,823,827,829]]
   λ> primosConsecutivosConSumasDigitalesPrimas 4 !! 50
   [129197,129209,129221,129223]

λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 2)

[[2,3],[3,5],[5,7],[41,43],[43,47]]

λ> take 5 (primosConsecutivosConSumasDigitalesPrimas 3)

[[2,3,5],[3,5,7],[41,43,47],[191,193,197],[193,197,199]]

λ> take 4 (primosConsecutivosConSumasDigitalesPrimas 4)

[[2,3,5,7],[3,5,7,11],[191,193,197,199],[821,823,827,829]]

λ> primosConsecutivosConSumasDigitalesPrimas 4 !! 50

[129197,129209,129221,129223]

Soluciones

import Data.Char (digitToInt)
import Data.List (isPrefixOf, sort, tails)
import Data.Numbers.Primes

primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]
primosConsecutivosConSumasDigitalesPrimas k = 
    [xs | xs <- map (take k) (tails primes),
          primosConsecutivos (sort (map sumaDigital xs))]

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

-- (sumaDigital n) es la suma de los dígitos de n. Por ejemplo, 
--    sumaDigital 325  ==  10
sumaDigital :: Integer -> Integer
sumaDigital = sum . digitos

-- (primosConsecutivos xs) se verifica si xs es una lista de primos
-- consecutivos. Por ejemplo,
--    primosConsecutivos [5,7,11]  ==  True
--    primosConsecutivos [5,7,17]  ==  False
primosConsecutivos :: [Integer] -> Bool
primosConsecutivos (x:xs) =
    isPrefixOf (x:xs) (dropWhile (<x) primes)

import Data.Char (digitToInt)

import Data.List (isPrefixOf, sort, tails)

import Data.Numbers.Primes

primosConsecutivosConSumasDigitalesPrimas :: Int -> [[Integer]]

primosConsecutivosConSumasDigitalesPrimas k =

[xs | xs <- map (take k) (tails primes),

primosConsecutivos (sort (map sumaDigital xs))]

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

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

digitos :: Integer -> [Integer]

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

-- (sumaDigital n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigital 325 == 10

sumaDigital :: Integer -> Integer

sumaDigital = sum . digitos

-- (primosConsecutivos xs) se verifica si xs es una lista de primos

-- consecutivos. Por ejemplo,

-- primosConsecutivos [5,7,11] == True

-- primosConsecutivos [5,7,17] == False

primosConsecutivos :: [Integer] -> Bool

primosConsecutivos (x:xs) =

isPrefixOf (x:xs) (dropWhile (<x) primes)

Referencias

Basado en el artículo DigitSums of some consecutive primes del blog Fun With Num3ers.

Primos que contienen al 2016

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

Definir la sucesión

   primosCon2016 :: [Integer]

1	primosCon2016 :: [Integer]

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

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

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

Soluciones

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

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

import Data.List (isInfixOf)

import Data.Numbers.Primes (primes)

primosCon2016 :: [Integer]

primosCon2016 =

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

Referencias

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

Puntos visibles en la cuadrícula de un plano

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

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

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

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

Definir la función

   nVisibles :: Integer -> Integer

1	nVisibles :: Integer -> Integer

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

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

nVisibles 6 == 23

nVisibles 10 == 63

nVisibles 100 == 6087

nVisibles 1000 == 608383

nVisibles 10000 == 60794971

nVisibles 100000 == 6079301507

Soluciones

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

type Punto = (Integer,Integer)

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

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

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

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

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

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

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

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


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

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

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

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

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

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

import Data.List (genericLength, group, sort)

import Data.Numbers.Primes (primeFactors)

type Punto = (Integer,Integer)

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

-- visible (4,5) == True

-- visible (4,6) == False

visible :: Punto -> Bool

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

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

-- de lado 1. Por ejemplo,

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

-- λ> sort (visibles 6)

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

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

-- 1ª definición de visibles

visibles1 :: Integer -> [Punto]

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

-- 2ª definición de visibles

visibles2 :: Integer -> [Punto]

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

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

-- Comparación de eficiencia

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

-- λ> length (visibles1 1000)

-- 608383

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

-- λ> length (visibles2 1000)

-- 608383

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

-- Usaremos la 2ª definición de visibles

visibles :: Integer -> [Punto]

visibles = visibles2

-- 1ª definición de nVisibles

nVisibles1 :: Integer -> Integer

nVisibles1 = genericLength . visibles

-- 2ª definición de nVisibles

nVisibles2 :: Integer -> Integer

nVisibles2 n =

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

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

visible (x,y)]

-- 3ª definición de nVisibles

nVisibles3 :: Integer -> Integer

nVisibles3 1 = 1

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

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

phi :: Integer -> Integer

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

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

factorizacion n =

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

-- 4ª definición de nVisibles

nVisibles4 :: Integer -> Integer

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

-- Comparación de eficiencia

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

-- λ> nVisibles1 1000

-- 608383

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

-- λ> nVisibles2 1000

-- 608383

-- λ> nVisibles3 1000

-- 608383

-- (0.05 secs, 0 bytes)

-- λ> nVisibles4 1000

-- 608383

-- (0.04 secs, 0 bytes)

Referencias

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

Cambios de signo

PorJosé A. Alonso 12-enero-201620-enero-2016

En una lista xs se produce un cambio de signo por cada elemento x de la lista junto el primero de los elementos de xs con signo opuesto al de x. Por ejemplo,en la lista [6,5,-4,0,-2,-7,0,-8,-1,4] hay 2 cambios de signo (entre (5,-4) y (-1,4)) y en la lista [6,5,-4,0, 2,-7,0,-8,-1,4] hay 4 cambios de signo (entre (5,-4), (-4,2), (2,-7) y(-1,4)).

Definir la función

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

1	nCambios :: (Num a, Ord a) => [a] -> Int

tal que (nCambios xs) es el número de cambios de signos de la lista xs. Por ejemplo,

   nCambios []                          ==  0
   nCambios [6,5,-4,0,-2,-7,0,-8,-1,4]  ==  2
   nCambios [6,5,-4,0, 2,-7,0,-8,-1,4]  ==  4

nCambios [] == 0

nCambios [6,5,-4,0,-2,-7,0,-8,-1,4] == 2

nCambios [6,5,-4,0, 2,-7,0,-8,-1,4] == 4

Soluciones

import Data.List (group)

-- 1ª definición
nCambios1 :: (Num a, Ord a) => [a] -> Int
nCambios1 = length . cambios

-- (cambios xs) es la lista de los pares de elementos de xs entre los
-- que se producen cambios de signo. Por ejemplo,
--    cambios [6,5,-4,0,-2,-7,0,-8,-1,4]  ==  [(5,-4),(-1,4)]
--    cambios [6,5,-4,0, 2,-7,0,-8,-1,4]  ==  [(5,-4),(-4,2),(2,-7),(-1,4)]
cambios :: (Num a, Ord a) => [a] -> [(a,a)]
cambios xs =
    [(x,y) | (x,y) <- zip ys (tail ys), x*y < 0]
    where ys = filter (/=0) xs

-- 2ª definición
nCambios2 :: (Num a, Ord a) => [a] -> Int
nCambios2 [] = 0
nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1

-- 3ª definición
nCambios3 :: (Num a, Ord a) => [a] -> Int
nCambios3 = pred . length . group . filter (/=0) . map signum

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

--    λ> nCambios1 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (3.84 secs, 679,805,392 bytes)
--    λ> nCambios2 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (0.98 secs, 694,247,368 bytes)
--    λ> nCambios3 (take (2*10^6) (cycle [3,0,-3]))
--    1333332
--    (0.95 secs, 708,118,976 bytes)

import Data.List (group)

-- 1ª definición

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

nCambios1 = length . cambios

-- (cambios xs) es la lista de los pares de elementos de xs entre los

-- que se producen cambios de signo. Por ejemplo,

-- cambios [6,5,-4,0,-2,-7,0,-8,-1,4] == [(5,-4),(-1,4)]

-- cambios [6,5,-4,0, 2,-7,0,-8,-1,4] == [(5,-4),(-4,2),(2,-7),(-1,4)]

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

cambios xs =

[(x,y) | (x,y) <- zip ys (tail ys), x*y < 0]

where ys = filter (/=0) xs

-- 2ª definición

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

nCambios2 [] = 0

nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1

-- 3ª definición

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

nCambios3 = pred . length . group . filter (/=0) . map signum

-- Comparación de eficiencia

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

-- λ> nCambios1 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (3.84 secs, 679,805,392 bytes)

-- λ> nCambios2 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (0.98 secs, 694,247,368 bytes)

-- λ> nCambios3 (take (2*10^6) (cycle [3,0,-3]))

-- 1333332

-- (0.95 secs, 708,118,976 bytes)

Parte libre de cuadrados y parte cuadrada de un número

PorJosé A. Alonso 11-enero-201618-enero-2016

La parte libre de cuadrados de un número n es el producto de todos sus divisores primos con exponente impar en la factorización prima de n. Por ejemplo, la parte libre de cuadrados de 360 es 10 ya que 360 = 2³3²5 y 2.5 = 10; además, 360 = 10.6²

La parte cuadrada de un número n es el mayor número cuadrado que divide a n. Por ejemplo, la parte cuadrada de 360 es 6.

Definir las funciones

   parteLibre    :: Integer -> Integer
   parteCuadrada :: Integer -> Integer

1 2	parteLibre :: Integer -> Integer parteCuadrada :: Integer -> Integer

tales que

(parteLibre x) es la parte libre de x. Por ejemplo,

     parteLibre 360                 ==  10
     parteLibre 1800                ==  2
     [parteLibre n | n <- [1..14]]  ==  [1,2,3,1,5,6,7,2,1,10,11,3,13,14]

parteLibre 360 == 10

parteLibre 1800 == 2

[parteLibre n | n <- [1..14]] == [1,2,3,1,5,6,7,2,1,10,11,3,13,14]

(parteCuadrada x) es la parte cuadrada de x. Por ejemplo,

     parteCuadrada 360                 ==  36
     parteCuadrada 1800                ==  900
     [parteCuadrada n | n <- [1..14]]  ==  [1,1,1,4,1,1,1,4,9,1,1,4,1,1]

parteCuadrada 360 == 36

parteCuadrada 1800 == 900

[parteCuadrada n | n <- [1..14]] == [1,1,1,4,1,1,1,4,9,1,1,4,1,1]

Soluciones

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

parteLibre :: Integer -> Integer
parteLibre n = product [p | (p,e) <- factorizacion n, odd e]

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

parteCuadrada :: Integer -> Integer
parteCuadrada n = n `div` parteLibre n

import Data.List (group, genericLength)

import Data.Numbers.Primes (primeFactors)

parteLibre :: Integer -> Integer

parteLibre n = product [p | (p,e) <- factorizacion n, odd e]

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

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

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

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

factorizacion n =

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

parteCuadrada :: Integer -> Integer

parteCuadrada n = n `div` parteLibre n

Referencias

N.J.A. Sloane, Sequence A008833 en OEIS.
N.J.A. Sloane, Sequence A007913 en OEIS.
E.W. Weisstein, Square part en MathWorld.
E.W. Weisstein, Squarefree part en MathWorld.

Puntos en una región

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

Definir la función

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

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

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

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

length (puntos 10) == 5

length (puntos 100) == 10

length (puntos 1000) == 15

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

-- 1ª definición

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

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

puntos1 n =

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

y <- [1..n],

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

-- 2ª definición

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

-- Calculando algunos elementos

-- λ> puntos1 10

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

-- λ> puntos1 20

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

-- λ> puntos1 100

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

-- λ> puntos1 89

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

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

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

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

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

menor (x,y) = x <= n

-- 3ª definición

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

-- Se observa que la lista de las segundas componentes

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

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

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

puntos3 n = zip (tail xs) xs

where xs = takeWhile (<=n) fibonacci

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

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

fibonacci :: [Integer]

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

-- Comparación de eficiencia

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

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

-- 15

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

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

-- 15

-- (0.02 secs, 0 bytes)

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

-- 143549

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

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

-- 143549

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

2016 es un número práctico

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

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

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

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

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

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

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

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

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

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

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

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

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

divisores :: Integer -> [Integer]

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

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

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

-- cada suma. Por ejemplo,

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

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

sumas :: [Integer] -> [Integer]

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

-- 2ª definición

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

esPractico2 :: Integer -> Bool

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

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

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

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

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

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

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

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

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

esSumable _ 0 = True

esSumable [] _ = False

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

-- 3ª definición

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

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

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

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

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

-- 1+e(j)

-- i-1 p(j) - 1

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

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

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

where xss = factorizacion n

(x:bases) = map fst xss

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

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

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

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

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

factorizacion n =

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

-- Comparación de eficiencia

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

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

-- 92

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

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

-- 92

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

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

-- 92

-- (0.02 secs, 0 bytes)

Referencias

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

Otras referencias

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

Suma con redondeos

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

Definir las funciones

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

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

tales que

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

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

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

Por ejemplo,

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

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

(limiteSumaRedondeos n) es la suma de la serie

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

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

Por ejemplo,

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

limiteSumaRedondeos 2000 == 1999

limiteSumaRedondeos 2016 == 2016

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- 1ª definición

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

sumaRedondeos1 :: Integer -> [Integer]

sumaRedondeos1 n =

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

where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer

limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer

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

-- 2ª definición

sumaRedondeos2 :: Integer -> [Integer]

sumaRedondeos2 n =

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

where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer

limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición

sumaRedondeos3 :: Integer -> [Integer]

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

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

n' = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer

limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición

sumaRedondeos4 :: Integer -> [Integer]

sumaRedondeos4 n = xs ++ repeat x

where n' = fromIntegral n

m = round (logBase 2 n')

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

x = last xs

limiteSumaRedondeos4 :: Integer -> Integer

limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia

-- λ> (sumaRedondeos1 4) !! 20000

-- 3

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

-- λ> (sumaRedondeos1 4) !! 30000

-- 3

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

-- λ> (sumaRedondeos3 4) !! 20000

-- 3

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

-- λ> (sumaRedondeos4 4) !! 20000

-- 3

-- (0.01 secs, 0 bytes)

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

sumaRedondeos :: Integer -> [Integer]

sumaRedondeos = sumaRedondeos3

-- 5ª definición

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

limiteSumaRedondeos5 :: Integer -> Integer

limiteSumaRedondeos5 n =

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

where n' = fromIntegral n

m = round (logBase 2 n')

Elementos óptimos

PorJosé A. Alonso 31-diciembre-20157-enero-2016

Definir la función

   optimos :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

1	optimos :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

tal que (optimos r f xs) es la lista de los elementos de xs donde la función f alcanza sus valores óptimos respecto de la relación r. Por ejemplo,

   optimos (<) length ["ab","c","de","f"]  ==  ["c","f"]
   optimos (>) length ["ab","c","de","f"]  ==  ["ab","de"]

1 2	optimos (<) length ["ab","c","de","f"] == ["c","f"] optimos (>) length ["ab","c","de","f"] == ["ab","de"]

Soluciones

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

optimos1 :: Eq a => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]
optimos1 r f xs = 
    [x | x <- xs, null [y | y <- xs, x /= y, r (f y) (f x)]]

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

optimos2 :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]
optimos2 r f xs = [x | x <- xs, f x `elem` ms]
    where ms = maximales r (map f xs) 

-- (maximales r xs) es la lista de los elementos de xs para los que no
-- hay ningún otro elemento de xs mayor según la relación r. Por
-- ejemplo, 
--    maximales (>) [2,3,4,6]                     ==  [6]
--    maximales (<) [2,3,4,6]                     ==  [2]
--    maximales (\x y -> mod x y == 0) [2,3,4,6]  ==  [4,6]
--    maximales (\x y -> mod y x == 0) [2,3,4,6]  ==  [2,3]
maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]
maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

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

--    λ> length $ optimos1 (>) length [replicate n 'a' | n <- [1..1000]]
--    1
--    (16.74 secs, 153,957,400 bytes)
--    λ> length $ optimos2 (>) length [replicate n 'a' | n <- [1..1000]]
--    1
--    (0.64 secs, 85,520,896 bytes)

-- 1ª definición

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

optimos1 :: Eq a => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

optimos1 r f xs =

[x | x <- xs, null [y | y <- xs, x /= y, r (f y) (f x)]]

-- 2ª definición

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

optimos2 :: Eq b => (b -> b -> Bool) -> (a -> b) -> [a] -> [a]

optimos2 r f xs = [x | x <- xs, f x `elem` ms]

where ms = maximales r (map f xs)

-- (maximales r xs) es la lista de los elementos de xs para los que no

-- hay ningún otro elemento de xs mayor según la relación r. Por

-- ejemplo,

-- maximales (>) [2,3,4,6] == [6]

-- maximales (<) [2,3,4,6] == [2]

-- maximales (\x y -> mod x y == 0) [2,3,4,6] == [4,6]

-- maximales (\x y -> mod y x == 0) [2,3,4,6] == [2,3]

maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

-- Comparación de eficiencia

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

-- λ> length $ optimos1 (>) length [replicate n 'a' | n <- [1..1000]]

-- 1

-- (16.74 secs, 153,957,400 bytes)

-- λ> length $ optimos2 (>) length [replicate n 'a' | n <- [1..1000]]

-- 1

-- (0.64 secs, 85,520,896 bytes)

Elementos maximales

PorJosé A. Alonso 30-diciembre-20157-enero-2016

Definir la función

   maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

1	maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]

tal que (maximales r xs) es la lista de los elementos de xs para los que no hay ningún otro elemento de xs mayor según la relación r. Por ejemplo,

   maximales (>) [2,3,4,6]                     ==  [6]
   maximales (<) [2,3,4,6]                     ==  [2]
   maximales (\x y -> mod x y == 0) [2,3,4,6]  ==  [4,6]
   maximales (\x y -> mod y x == 0) [2,3,4,6]  ==  [2,3]

maximales (>) [2,3,4,6] == [6]

maximales (<) [2,3,4,6] == [2]

maximales (\x y -> mod x y == 0) [2,3,4,6] == [4,6]

maximales (\x y -> mod y x == 0) [2,3,4,6] == [2,3]

Soluciones

maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a]
maximales r xs = [x | x <- xs, null [y | y <- xs, y /= x, r y x]]

1 2	maximales :: Eq a => (a -> a -> Bool) -> [a] -> [a] maximales r xs = [x \| x <- xs, null [y \| y <- xs, y /= x, r y x]]

Operación sobre todos los pares

PorJosé A. Alonso 28-diciembre-20154-enero-2016

Definir la función

   todosPares :: (a -> b -> c) -> [a] -> [b] -> [c]

1	todosPares :: (a -> b -> c) -> [a] -> [b] -> [c]

tal que (todosPares f xs ys) es el resultado de aplicar la operación f a todos los pares de xs e ys. Por ejemplo,

   todosPares (*) [2,3,5] [7,11]            == [14,22,21,33,35,55]
   todosPares (\x y -> x:show y) "ab" [7,5] == ["a7","a5","b7","b5"]

1 2	todosPares (*) [2,3,5] [7,11] == [14,22,21,33,35,55] todosPares (\x y -> x:show y) "ab" [7,5] == ["a7","a5","b7","b5"]

Soluciones

-- 1ª definición (por comprensión)
todosPares1 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares1 f xs ys = [f x y | x <- xs, y <- ys] 

-- 2ª definición (por recursión)
todosPares2 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares2 _ []     _  = []
todosPares2 f (x:xs) ys = map (f x) ys ++ todosPares2 f xs ys

-- 3ª definición (recursión con auxiliar)
todosPares3 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares3 f xs ys = aux xs where
   aux []     = []
   aux (x:xs) = map (f x) ys ++ aux xs

-- 4ª definición (recursión con auxiliar)
todosPares4 :: (a -> b -> c) -> [a] -> [b] -> [c]
todosPares4 f xs ys = 
    (foldr (\x zs -> map (f x) ys ++ zs) []) xs

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

todosPares1 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares1 f xs ys = [f x y | x <- xs, y <- ys]

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

todosPares2 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares2 _ [] _ = []

todosPares2 f (x:xs) ys = map (f x) ys ++ todosPares2 f xs ys

-- 3ª definición (recursión con auxiliar)

todosPares3 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares3 f xs ys = aux xs where

aux [] = []

aux (x:xs) = map (f x) ys ++ aux xs

-- 4ª definición (recursión con auxiliar)

todosPares4 :: (a -> b -> c) -> [a] -> [b] -> [c]

todosPares4 f xs ys =

(foldr (\x zs -> map (f x) ys ++ zs) []) xs

Árbol de Navidad

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

Definir el procedimiento

   arbol :: Int -> IO ()

1	arbol :: Int -> IO ()

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

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

λ> arbol 5

XXX

XXXXX

XXXXXXX

XXXXXXXXX

λ> arbol 6

XXX

XXXXX

XXXXXXX

XXXXXXXXX

XXXXXXXXXXX

λ> arbol 7

XXX

XXXXX

XXXXXXX

XXXXXXXXX

XXXXXXXXXXX

XXXXXXXXXXXXX

Soluciones

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

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

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

arbol :: Int -> IO ()

arbol n = do

putStrLn ""

sequence_ [putStrLn c | c <- triangulo n]

sequence_ [putStrLn c | c <- rectangulo n]

putStrLn ""

triangulo :: Int -> [String]

triangulo n =

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

rectangulo :: Int -> [String]

rectangulo n =

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

Producto infinito

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

Definir la función

   productoInfinito :: [Int] -> [Int]

1	productoInfinito :: [Int] -> [Int]

tal que (productoInfinito xs) es la lista infinita que en la posición N tiene el producto de los N primeros elementos de la lista infinita xs. Por ejemplo,

   take 5 (productoInfinito [1..])    ==  [1,2,6,24,120]
   take 5 (productoInfinito [2,4..])  ==  [2,8,48,384,3840]
   take 5 (productoInfinito [1,3..])  ==  [1,3,15,105,945]

take 5 (productoInfinito [1..]) == [1,2,6,24,120]

take 5 (productoInfinito [2,4..]) == [2,8,48,384,3840]

take 5 (productoInfinito [1,3..]) == [1,3,15,105,945]

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

Soluciones

-- 1ª definición (por comprensión):
productoInfinito1 :: [Integer] -> [Integer]
productoInfinito1 xs = [product (take n xs) | n <- [1..]]

-- 2ª definición (por recursión)
productoInfinito2 :: [Integer] -> [Integer]
productoInfinito2 (x:y:zs) = x : productoInfinito2 (x*y:zs)

-- 2ª definición (por recursión y map)
productoInfinito3 :: [Integer] -> [Integer]
productoInfinito3 []     = [1]
productoInfinito3 (x:xs) = map (x*) (1 : productoInfinito3 xs)

-- 4ª definición (con scanl1)
productoInfinito4 :: [Integer] -> [Integer]
productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia
--    λ> take 20 (show (productoInfinito1 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.35 secs, 98,287,328 bytes)
--    λ> take 20 (show (productoInfinito2 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.35 secs, 98,840,440 bytes)
--    λ> take 20 (show (productoInfinito3 [2,4..] !! 10000))
--    "11358071114466915693"
--    (7.36 secs, 6,006,360,472 bytes)
--    λ> take 20 (show (productoInfinito4 [2,4..] !! 10000))
--    "11358071114466915693"
--    (0.34 secs, 96,367,000 bytes)

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

productoInfinito1 :: [Integer] -> [Integer]

productoInfinito1 xs = [product (take n xs) | n <- [1..]]

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

productoInfinito2 :: [Integer] -> [Integer]

productoInfinito2 (x:y:zs) = x : productoInfinito2 (x*y:zs)

-- 2ª definición (por recursión y map)

productoInfinito3 :: [Integer] -> [Integer]

productoInfinito3 [] = [1]

productoInfinito3 (x:xs) = map (x*) (1 : productoInfinito3 xs)

-- 4ª definición (con scanl1)

productoInfinito4 :: [Integer] -> [Integer]

productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia

-- λ> take 20 (show (productoInfinito1 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.35 secs, 98,287,328 bytes)

-- λ> take 20 (show (productoInfinito2 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.35 secs, 98,840,440 bytes)

-- λ> take 20 (show (productoInfinito3 [2,4..] !! 10000))

-- "11358071114466915693"

-- (7.36 secs, 6,006,360,472 bytes)

-- λ> take 20 (show (productoInfinito4 [2,4..] !! 10000))

-- "11358071114466915693"

-- (0.34 secs, 96,367,000 bytes)

Listas hermanadas

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

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

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

Definir la función

   hermanada :: [Int] -> Bool

1	hermanada :: [Int] -> Bool

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

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

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

hermanada [2,3,5] == False

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

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

Soluciones

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

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

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

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

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

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

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

hermanada1 :: [Int] -> Bool

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

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

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

hermanos :: (Int, Int) -> Bool

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

-- 2ª definición (con all)

hermanada2 :: [Int] -> Bool

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

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

hermanada3 :: [Int] -> Bool

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

hermanada3 _ = True

-- 4ª definición (por plegado)

hermanada4 :: [Int] -> Bool

hermanada4 xs =

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

-- Comparación de eficiencia

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

-- True

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

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

-- True

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

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

-- True

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

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

-- True

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

Suma de elementos en posiciones dadas

PorJosé A. Alonso 17-diciembre-201524-diciembre-2015

Definir la función

   sumaEnPosicion :: [Int] -> [Int] -> Int

1	sumaEnPosicion :: [Int] -> [Int] -> Int

tal que (sumaEnPosicion xs ys) es la suma de todos los elementos de xs cuyas posiciones se indican en ys. Por ejemplo,

   sumaEnPosicion [1,2,3] [0,2]  ==  4
   sumaEnPosicion [4,6,2] [1,3]  ==  6
   sumaEnPosicion [3,5,1] [0,1]  ==  8

sumaEnPosicion [1,2,3] [0,2] == 4

sumaEnPosicion [4,6,2] [1,3] == 6

sumaEnPosicion [3,5,1] [0,1] == 8

Soluciones

-- 1ª solución
sumaEnPosicion1 :: [Int] -> [Int] -> Int
sumaEnPosicion1 xs ys = sum [xs !! y | y <- ys, 0 <= y, y < n]
    where n = length xs

-- 2ª solución
sumaEnPosicion2 :: [Int] -> [Int] -> Int
sumaEnPosicion2 xs ys = aux xs [y | y <- ys, 0 <= y, y < n] 0
    where n = length xs
          aux _  []     r = r
          aux xs (y:ys) r = aux xs ys (r + xs!!y)

-- 1ª solución

sumaEnPosicion1 :: [Int] -> [Int] -> Int

sumaEnPosicion1 xs ys = sum [xs !! y | y <- ys, 0 <= y, y < n]

where n = length xs

-- 2ª solución

sumaEnPosicion2 :: [Int] -> [Int] -> Int

sumaEnPosicion2 xs ys = aux xs [y | y <- ys, 0 <= y, y < n] 0

where n = length xs

aux _ [] r = r

aux xs (y:ys) r = aux xs ys (r + xs!!y)

Factorizable respecto de una lista

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

Definir la función

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

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

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

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

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

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

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

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

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

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

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

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

factorizable 12 [5,6] == False

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

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

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

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

Soluciones

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

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

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

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

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

-- 1ª definición

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

factorizable1 1 _ = True

factorizable1 0 ys = 0 `elem` ys

factorizable1 x ys =

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

, y /= 0 && y /= 1

, x `mod` y == 0 ]

-- 2ª definición

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

factorizable2 1 _ = True

factorizable2 0 ys = 0 `elem` ys

factorizable2 x ys =

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

where aux _ [] = False

aux 1 _ = True

aux x ys | null zs = False

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

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

-- 3ª definición

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

factorizable3 1 _ = True

factorizable3 0 ys = 0 `elem` ys

factorizable3 x ys =

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

where aux _ [] = False

aux 1 _ = True

aux x (y:ys)

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

| otherwise = aux x ys

-- Comparación de eficiencia

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

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

-- True

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

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

-- True

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

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

-- True

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

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

-- False

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

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

-- False

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

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

-- False

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

Año cúbico

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

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

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

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

Definir la función

   esCubico :: Integer -> Bool

1	esCubico :: Integer -> Bool

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

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

esCubico 2016 == True

esCubico 2017 == False

esCubico 189005670081900441 == True

esCubico 189005670081900442 == False

Soluciones

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

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

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

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

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

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

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

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

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

-- 1ª definición

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

esCubico1 :: Integer -> Bool

esCubico1 x = pertenece x cubicos

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

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

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

cubicos :: [Integer]

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

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

-- ys. Por ejemplo,

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

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

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

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

-- 2ª definición

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

esCubico2 :: Integer -> Bool

esCubico2 x = pertenece x (cubicosDesde k)

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

cubicosDesde :: Integer -> [Integer]

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

-- Comparación de eficiencia

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

-- λ> esCubico1 189005670081900441

-- True

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

-- λ> esCubico2 189005670081900441

-- True

-- (0.01 secs, 0 bytes)

Los números de Smith

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

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

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

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

y el 4937775 también lo es ya que

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

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

Definir las funciones

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

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

tales que

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

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

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

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

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

λ> take 17 smith

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

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

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

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

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

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

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

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

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

smith :: [Integer]

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

Los números de Armstrong

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

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

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

371 = 3^3 + 7 + 1³ y

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

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

Definir las funciones

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

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

tales que

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

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

esArmstrong 371 == True

esArmstrong 8208 == True

esArmstrong 4210818 == True

esArmstrong 2015 == False

esArmstrong 115132219018763992565095597973971522401 == True

esArmstrong 115132219018763992565095597973971522402 == False

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

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

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

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

Soluciones

import Test.QuickCheck

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

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

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

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

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

import Test.QuickCheck

esArmstrong :: Integer -> Bool

esArmstrong x =

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

where n = length (show x)

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

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

digitos :: Integer -> [Integer]

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

armstrong :: [Integer]

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

-- La propiedad es

prop_Armstrong :: Integer -> Bool

prop_Armstrong n =

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

-- La comprobación es

-- λ> quickCheck prop_Armstrong

-- +++ OK, passed 100 tests.

Repeticiones según la posición

PorJosé A. Alonso 26-noviembre-20151-mayo-2016

Definir la función

   transformada :: [a] -> [a]

1	transformada :: [a] -> [a]

tal que (transformada xs) es la lista obtenida repitiendo cada elemento tantas veces como indica su posición en la lista. Por ejemplo,

   transformada [7,2,5] == [7,2,2,5,5,5]
   transformada "eco"   == "eccooo"

1 2	transformada [7,2,5] == [7,2,2,5,5,5] transformada "eco" == "eccooo"

Comprobar con QuickCheck si la transformada de una lista de n números enteros, con n ≥ 2, tiene menos de n³ elementos.

Soluciones

import Test.QuickCheck

transformada :: [a] -> [a]
transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es
prop_transformada :: [Int] -> Property
prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3
    where n = length xs

-- La comprobación es
--    ghci> quickCheck prop_transformada
--    +++ OK, passed 100 tests.

import Test.QuickCheck

transformada :: [a] -> [a]

transformada xs = concat [replicate n x | (n,x) <- zip [1..] xs]

-- La propiedad es

prop_transformada :: [Int] -> Property

prop_transformada xs = n >= 2 ==> length (transformada xs) < n^3

where n = length xs

-- La comprobación es

-- ghci> quickCheck prop_transformada

-- +++ OK, passed 100 tests.

Ganadores de las elecciones

PorJosé A. Alonso 24-noviembre-20151-diciembre-2015

Los resultados de las votaciones a delegado en un grupo de clase se recogen mediante listas de asociación. Por ejemplo,

   votos :: [(String,Int)]
   votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),
            ("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

votos :: [(String,Int)]

votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),

("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

Definir la función

   ganadores :: [(String,Int)] -> [String]

1	ganadores :: [(String,Int)] -> [String]

tal que (ganadores xs) es la lista de los estudiantes con mayor número de votos en xs. Por ejemplo,

    ganadores votos == ["Julia Rus","Pedro Ruiz"]

1	ganadores votos == ["Julia Rus","Pedro Ruiz"]

Soluciones

votos :: [(String,Int)]
votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),
         ("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

ganadores :: [(String,Int)] -> [String]
ganadores xs = [c | (c,x) <- xs, x == maxVotos]
    where maxVotos = maximum [j | (i,j) <- xs]

votos :: [(String,Int)]

votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),

("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

ganadores :: [(String,Int)] -> [String]

ganadores xs = [c | (c,x) <- xs, x == maxVotos]

where maxVotos = maximum [j | (i,j) <- xs]

Listas de igual longitud

PorJosé A. Alonso 23-noviembre-201530-noviembre-2015

Definir la función

   mismaLongitud :: [[a]] -> Bool

1	mismaLongitud :: [[a]] -> Bool

tal que (mismaLongitud xss) se verifica si todas las listas de la lista de listas xss tienen la misma longitud. Por ejemplo,

   mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True
   mismaLongitud [[1,2],[6,4,5],[0,0]]     == False

1 2	mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True mismaLongitud [[1,2],[6,4,5],[0,0]] == False

Soluciones

import Data.List (nub)    

-- 1ª solución:
mismaLongitud1 :: [[a]] -> Bool
mismaLongitud1 []       = True
mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]
    where n = length xs

-- 2ª solución:
mismaLongitud2 :: [[a]] -> Bool
mismaLongitud2 xss = 
    and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:
mismaLongitud3 :: [[a]] -> Bool
mismaLongitud3 (xs:ys:xss) = 
    length xs == length ys && mismaLongitud3 (ys:xss)
mismaLongitud3 _ = True           

-- 4ª solución
mismaLongitud4 :: [[a]] -> Bool
mismaLongitud4 [] = True
mismaLongitud4 (xs:xss) =
    all (\ys -> length ys == n) xss
    where n = length xs 

-- 5ª solución
mismaLongitud5 :: [[a]] -> Bool
mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución
mismaLongitud6 :: [[a]] -> Bool
mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia
--    λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))
--    True
--    (5.05 secs, 0 bytes)
--    λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))
--    True
--    (9.98 secs, 0 bytes)
--    λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))
--    True
--    (10.17 secs, 0 bytes)
--    λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))
--    True
--    (5.18 secs, 0 bytes)
--    λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))
--    True
--    (4.30 secs, 0 bytes)
--    λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))
--    True
--    (4.19 secs, 0 bytes)

import Data.List (nub)

-- 1ª solución:

mismaLongitud1 :: [[a]] -> Bool

mismaLongitud1 [] = True

mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]

where n = length xs

-- 2ª solución:

mismaLongitud2 :: [[a]] -> Bool

mismaLongitud2 xss =

and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]

-- 3ª solución:

mismaLongitud3 :: [[a]] -> Bool

mismaLongitud3 (xs:ys:xss) =

length xs == length ys && mismaLongitud3 (ys:xss)

mismaLongitud3 _ = True

-- 4ª solución

mismaLongitud4 :: [[a]] -> Bool

mismaLongitud4 [] = True

mismaLongitud4 (xs:xss) =

all (\ys -> length ys == n) xss

where n = length xs

-- 5ª solución

mismaLongitud5 :: [[a]] -> Bool

mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1

-- 6ª solución

mismaLongitud6 :: [[a]] -> Bool

mismaLongitud6 = null . drop 1 . nub . map length

-- Comparación de eficiencia

-- λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))

-- True

-- (5.05 secs, 0 bytes)

-- λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))

-- True

-- (9.98 secs, 0 bytes)

-- λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))

-- True

-- (10.17 secs, 0 bytes)

-- λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))

-- True

-- (5.18 secs, 0 bytes)

-- λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))

-- True

-- (4.30 secs, 0 bytes)

-- λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))

-- True

-- (4.19 secs, 0 bytes)

Ternas con suma acotada

PorJosé A. Alonso 20-noviembre-20151-mayo-2016

Definir la función

   ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

1	ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

tal que (ternasAcotadas xs n) es el conjunto de ternas de números naturales de xs cuya suma es menor que n. Por ejemplo,

   ternasAcotadas [5,1,5,4,7] 12      ==  [(1,4,5),(1,5,5)]
   ternasAcotadas [5,1,5,4,7] 11      ==  [(1,4,5)]
   ternasAcotadas [5,1,5,4,7] 10      ==  []
   ternasAcotadas [1..10^6] 8         ==  [(1,2,3),(1,2,4)]
   ternasAcotadas [10^6,10^6-1..1] 8  ==  [(1,2,3),(1,2,4)]

ternasAcotadas [5,1,5,4,7] 12 == [(1,4,5),(1,5,5)]

ternasAcotadas [5,1,5,4,7] 11 == [(1,4,5)]

ternasAcotadas [5,1,5,4,7] 10 == []

ternasAcotadas [1..10^6] 8 == [(1,2,3),(1,2,4)]

ternasAcotadas [10^6,10^6-1..1] 8 == [(1,2,3),(1,2,4)]

Soluciones

import Data.List (tails, sort, nub)

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

ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas xs n =
    nub [(x,y,z) | (x,y,z) <- ternas (sort xs)
                 , x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,
--    λ> ternas [1..5]
--    [(1,2,3),(1,2,4),(1,2,5),(1,3,4),(1,3,5),(1,4,5),
--     (2,3,4),(2,3,5),(2,4,5),
--     (3,4,5)]
ternas :: [a] -> [(a,a,a)]
ternas xs = [(x,y,z) | (x:ys) <- tails xs
                     , (y:zs) <- tails ys
                     , z <- zs]

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

ternasAcotadas2 :: [Int] -> Int -> [(Int,Int,Int)]
ternasAcotadas2 xs n = nub (aux (sort xs))
    where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)
                            , (y:zs) <- tails (takeWhile (< (n-x)) ys)
                            , z <- takeWhile (< (n-x-y)) zs]

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

--    λ> ternasAcotadas [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (336.06 secs, 50,595,444,208 bytes)
--    λ> ternasAcotadas2 [1..1000] 10
--    [(1,2,3),(1,2,4),(1,2,5),(1,2,6),(1,3,4),(1,3,5),(2,3,4)]
--    (0.00 secs, 0 bytes)

import Data.List (tails, sort, nub)

-- 1ª definición

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

ternasAcotadas :: [Int] -> Int -> [(Int,Int,Int)]

ternasAcotadas xs n =

nub [(x,y,z) | (x,y,z) <- ternas (sort xs)

, x+y+z < n]

-- (ternas xs) es la lista de ternas de elementos de xs. Por ejemplo,

-- λ> ternas [1..5]

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

-- (2,3,4),(2,3,5),(2,4,5),

-- (3,4,5)]

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

ternas xs = [(x,y,z) | (x:ys) <- tails xs

, (y:zs) <- tails ys

, z <- zs]

-- 2ª definición

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

ternasAcotadas2 :: [Int] -> Int -> [(Int,Int,Int)]

ternasAcotadas2 xs n = nub (aux (sort xs))

where aux xs = [(x,y,z) | (x:ys) <- tails (takeWhile (< n) xs)

, (y:zs) <- tails (takeWhile (< (n-x)) ys)

, z <- takeWhile (< (n-x-y)) zs]

-- Comparación de eficiencia

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

-- λ> ternasAcotadas [1..1000] 10

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

-- (336.06 secs, 50,595,444,208 bytes)

-- λ> ternasAcotadas2 [1..1000] 10

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

-- (0.00 secs, 0 bytes)

Productos de N números consecutivos

PorJosé A. Alonso 17-noviembre-201526-marzo-2022

La semana pasada se planteó en Twitter el siguiente problema

Se observa que

      1x2x3x4 = 2x3x4 
      2x3x4x5 = 4x5x6

1 2	1x2x3x4 = 2x3x4 2x3x4x5 = 4x5x6

¿Existen ejemplos de otros productos de cuatro enteros consecutivos iguales a un producto de tres enteros consecutivos?

Definir la función

   esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

1	esProductoDeNconsecutivos :: Integer -> Integer -> Maybe Integer

tal que (esProductoDeNconsecutivos n x) es (Just m) si x es el producto de n enteros consecutivos a partir de m y es Nothing si x no es el producto de n enteros consecutivos. Por ejemplo,

   esProductoDeNconsecutivos 3   6  == Just 1
   esProductoDeNconsecutivos 4   6  == Nothing
   esProductoDeNconsecutivos 4  24  == Just 1
   esProductoDeNconsecutivos 3  24  == Just 2
   esProductoDeNconsecutivos 3 120  == Just 4
   esProductoDeNconsecutivos 4 120  == Just 2

esProductoDeNconsecutivos 3 6 == Just 1

esProductoDeNconsecutivos 4 6 == Nothing

esProductoDeNconsecutivos 4 24 == Just 1

esProductoDeNconsecutivos 3 24 == Just 2

esProductoDeNconsecutivos 3 120 == Just 4

esProductoDeNconsecutivos 4 120 == Just 2

Para ejemplos mayores,

   λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])
   Just 100000000000000000000
   λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])
   Nothing
   λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])
   Just 100000000000000000000

λ> esProductoDeNconsecutivos 3 (product [10^20..2+10^20])

Just 100000000000000000000

λ> esProductoDeNconsecutivos2 4 (product [10^20..2+10^20])

Nothing

λ> esProductoDeNconsecutivos2 4 (product [10^20..3+10^20])

Just 100000000000000000000

Usando la función esProductoDeNconsecutivos resolver el problema.

Soluciones

import Data.Maybe

-- 1ª definición
esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos1 n x 
    | null productos = Nothing
    | otherwise      = Just (head productos)
    where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición
esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer
esProductoDeNconsecutivos2 n x = aux k
    where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)
          aux m | y == x    = Just m
                | y <  x    = aux (m+1)
                | otherwise = Nothing
                where y = product [m..m+n-1]

-- Comparación de eficiencia
--    λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])
--    Just 10000000
--    (12.37 secs, 5678433692 bytes)
--    λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])
--    Just 10000000
--    (0.00 secs, 1554932 bytes)

-- Solución del problema
-- =====================

soluciones :: [Integer]
soluciones = [x | x <- [121..]
                , isJust (esProductoDeNconsecutivos2 4 x)
                , isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es
--    λ> head soluciones
--    175560
--    λ> esProductoDeNconsecutivos2 4 175560
--    Just 19
--    λ> esProductoDeNconsecutivos2 3 175560
--    Just 55
--    λ> product [19,20,21,22] 
--    175560
--    λ> product [55,56,57]
--    175560
--    λ> product [19,20,21,22] == product [55,56,57]
--    True

-- Se puede definir una función para automatizar el proceso anterior:
soluciones2 :: [(Integer,[Integer],[Integer])]
soluciones2 = [(x,[a..a+3],[b..b+2]) 
               | x <- [121..]
               , let y = esProductoDeNconsecutivos2 4 x
               , isJust y
               , let z = esProductoDeNconsecutivos2 3 x
               , isJust z
               , let a = fromJust y
               , let b = fromJust z
               ]

-- El cálculo es 
--    λ> head soluciones2
--    (175560,[19,20,21,22],[55,56,57])

import Data.Maybe

-- 1ª definición

esProductoDeNconsecutivos1 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos1 n x

| null productos = Nothing

| otherwise = Just (head productos)

where productos = [m | m <- [1..x-n], product [m..m+n-1] == x]

-- 2ª definición

esProductoDeNconsecutivos2 :: Integer -> Integer -> Maybe Integer

esProductoDeNconsecutivos2 n x = aux k

where k = floor (fromIntegral x ** (1/(fromIntegral n))) - (n `div` 2)

aux m | y == x = Just m

| y < x = aux (m+1)

| otherwise = Nothing

where y = product [m..m+n-1]

-- Comparación de eficiencia

-- λ> esProductoDeNconsecutivos1 3 (product [10^7..2+10^7])

-- Just 10000000

-- (12.37 secs, 5678433692 bytes)

-- λ> esProductoDeNconsecutivos2 3 (product [10^7..2+10^7])

-- Just 10000000

-- (0.00 secs, 1554932 bytes)

-- Solución del problema

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

soluciones :: [Integer]

soluciones = [x | x <- [121..]

, isJust (esProductoDeNconsecutivos2 4 x)

, isJust (esProductoDeNconsecutivos2 3 x)]

-- El cálculo es

-- λ> head soluciones

-- 175560

-- λ> esProductoDeNconsecutivos2 4 175560

-- Just 19

-- λ> esProductoDeNconsecutivos2 3 175560

-- Just 55

-- λ> product [19,20,21,22]

-- 175560

-- λ> product [55,56,57]

-- 175560

-- λ> product [19,20,21,22] == product [55,56,57]

-- True

-- Se puede definir una función para automatizar el proceso anterior:

soluciones2 :: [(Integer,[Integer],[Integer])]

soluciones2 = [(x,[a..a+3],[b..b+2])

| x <- [121..]

, let y = esProductoDeNconsecutivos2 4 x

, isJust y

, let z = esProductoDeNconsecutivos2 3 x

, isJust z

, let a = fromJust y

, let b = fromJust z

]

-- El cálculo es

-- λ> head soluciones2

-- (175560,[19,20,21,22],[55,56,57])

Números muy pares

PorJosé A. Alonso 13-noviembre-201520-noviembre-2015

Un entero positivo x es muy par si tanto x como x² sólo contienen cifras pares. Por ejemplo, 200 es muy par porque todas las cifras de 200 y 200² = 40000 son pares; pero 26 no lo es porque 26² = 676 tiene cifras impares.

Definir la función

   siguienteMuyPar :: Integer -> Integer

1	siguienteMuyPar :: Integer -> Integer

tal que (siguienteMuyPar x) es menor número mayor que x que es muy par. Por ejemplo,

   siguienteMuyPar 300           ==  668
   siguienteMuyPar 668           ==  680
   siguienteMuyPar 828268400000  ==  828268460602

siguienteMuyPar 300 == 668

siguienteMuyPar 668 == 680

siguienteMuyPar 828268400000 == 828268460602

Soluciones

siguienteMuyPar :: Integer -> Integer
siguienteMuyPar x = 
    head [n | n <- [y,y+2..], muyPar n]
    where y = siguientePar x

-- (siguientePar x) es el primer número mayor que x que es par. Por
-- ejemplo, 
--    siguientePar 3  ==  4
--    siguientePar 4  ==  6
siguientePar :: Integer -> Integer
siguientePar x | odd x     = x+1
               | otherwise = x+2

-- (muyPar x) se verifica si x es muy par. Por ejemplo,
--    muyPar 200           == True
--    muyPar 26            == False
muyPar :: Integer -> Bool
muyPar n = all even (digitos n) && all even (digitos (n*n))

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

siguienteMuyPar :: Integer -> Integer

siguienteMuyPar x =

head [n | n <- [y,y+2..], muyPar n]

where y = siguientePar x

-- (siguientePar x) es el primer número mayor que x que es par. Por

-- ejemplo,

-- siguientePar 3 == 4

-- siguientePar 4 == 6

siguientePar :: Integer -> Integer

siguientePar x | odd x = x+1

| otherwise = x+2

-- (muyPar x) se verifica si x es muy par. Por ejemplo,

-- muyPar 200 == True

-- muyPar 26 == False

muyPar :: Integer -> Bool

muyPar n = all even (digitos n) && all even (digitos (n*n))

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

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

digitos :: Integer -> [Int]

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

Listas decrecientes

PorJosé A. Alonso 10-noviembre-201525-abril-2021

Definir la función

   listasDecrecientesDesde :: Int -> [[Int]]

1	listasDecrecientesDesde :: Int -> [[Int]]

tal que (listasDecrecientesDesde n) es la lista de las sucesiones estrictamente decrecientes cuyo primer elemento es n. Por ejemplo,

   ghci> listasDecrecientesDesde 2
   [[2],[2,1],[2,1,0],[2,0]]
   ghci> listasDecrecientesDesde 3
   [[3],[3,2],[3,2,1],[3,2,1,0],[3,2,0],[3,1],[3,1,0],[3,0]]

ghci> listasDecrecientesDesde 2

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

ghci> listasDecrecientesDesde 3

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

Soluciones

listasDecrecientesDesde :: Int -> [[Int]]
listasDecrecientesDesde 0 = [[0]]
listasDecrecientesDesde n =
    [n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

listasDecrecientesDesde :: Int -> [[Int]]

listasDecrecientesDesde 0 = [[0]]

listasDecrecientesDesde n =

[n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

Primos gemelos próximos a múltiplos de 6

PorJosé A. Alonso 6-noviembre-201513-noviembre-2015

Un par de números primos (p,q) es un par de números primos gemelos si su distancia de 2; es decir, si q = p+2. Por ejemplo, (17,19) es una par de números primos gemelos.

Se dice que un par de números (x,y) está próximo a un múltiplo de 6 si es de la forma (6*n-1,6*n+1). Por ejemplo, (17,19) está cerca de un múltiplo de 6 porque (17,19) = (6*3-1,6*3+1).

Definir las funciones

   primosGemelos :: Integer -> [(Integer,Integer)]
   primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

1 2	primosGemelos :: Integer -> [(Integer,Integer)] primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]

tales que

(primosGemelos n) es la lista de los primos gemelos menores que n. Por ejemplo,

     primosGemelos 50  == [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43)]
     primosGemelos 43  == [(3,5),(5,7),(11,13),(17,19),(29,31)]

1 2	primosGemelos 50 == [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43)] primosGemelos 43 == [(3,5),(5,7),(11,13),(17,19),(29,31)]

(primosGemelosNoProximosAmultiplosDe6 n) es la lista de los primos gemelos menores que n que no están próximos a un múltiplo de 6. Por ejemplo,

     primosGemelosNoProximosAmultiplosDe6 50              == [(3,5)]
     length (primosGemelosNoProximosAmultiplosDe6 (10^9)) == 1

1 2	primosGemelosNoProximosAmultiplosDe6 50 == [(3,5)] length (primosGemelosNoProximosAmultiplosDe6 (10^9)) == 1

Soluciones

primosGemelos :: Integer -> [(Integer,Integer)]
primosGemelos n = [(x,x+2) | x <- [3,5..n-3], 
                             primo x,
                             primo (x+2)]

primo :: Integer -> Bool
primo n = divisores n == [1,n]

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

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool
proximosAmultiplosDe6 (x,y) =
    (x+1) `mod` 6 == 0 && y == 6*n+1
    where n = (x+1) `div` 6

primosGemelosNoProximosAmultiplosDe6 :: Integer -> [(Integer,Integer)]
primosGemelosNoProximosAmultiplosDe6 n =
    [p | p <- primosGemelos n,
         not (proximosAmultiplosDe6 p)]


-- Experimentado con primosGemelosNProximosAmultiplosDe6
--    primosGemelosNoProximosAmultiplosDe6 50    == [(3,5)]
--    primosGemelosNoProximosAmultiplosDe6 500   == [(3,5)]
--    primosGemelosNoProximosAmultiplosDe6 5000  == [(3,5)]
-- se observa que el único par de primos gemelos no próximos a múltiplos
-- de 6 es el (3,5). Su demostración es la siguiente:
--
-- Para cualquier n > 3, se tiene que de los tres números n-1, n. n+1
-- uno es divisible por 2 y alguno es divisible por 3. Si n-1 y n+1 son
-- primos, entonces el que es divisible por 2 y por 3 es n y, por tanto,
-- n es divisible por 6 y (n-1,n+1) están próximos a un múltiplo de 6.

-- Usando la propiedad tenemos una definición más eficiente
primosGemelosNoProximosAmultiplosDe6' :: Integer -> [(Integer,Integer)]
primosGemelosNoProximosAmultiplosDe6' n = [(3,5)]

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

primosGemelos n = [(x,x+2) | x <- [3,5..n-3],

primo x,

primo (x+2)]

primo :: Integer -> Bool

primo n = divisores n == [1,n]

divisores :: Integer -> [Integer]

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

proximosAmultiplosDe6 :: (Integer,Integer) -> Bool

proximosAmultiplosDe6 (x,y) =

(x+1) `mod` 6 == 0 && y == 6*n+1

where n = (x+1) `div` 6

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

primosGemelosNoProximosAmultiplosDe6 n =

[p | p <- primosGemelos n,

not (proximosAmultiplosDe6 p)]

-- Experimentado con primosGemelosNProximosAmultiplosDe6

-- primosGemelosNoProximosAmultiplosDe6 50 == [(3,5)]

-- primosGemelosNoProximosAmultiplosDe6 500 == [(3,5)]

-- primosGemelosNoProximosAmultiplosDe6 5000 == [(3,5)]

-- se observa que el único par de primos gemelos no próximos a múltiplos

-- de 6 es el (3,5). Su demostración es la siguiente:

-- Para cualquier n > 3, se tiene que de los tres números n-1, n. n+1

-- uno es divisible por 2 y alguno es divisible por 3. Si n-1 y n+1 son

-- primos, entonces el que es divisible por 2 y por 3 es n y, por tanto,

-- n es divisible por 6 y (n-1,n+1) están próximos a un múltiplo de 6.

-- Usando la propiedad tenemos una definición más eficiente

primosGemelosNoProximosAmultiplosDe6' :: Integer -> [(Integer,Integer)]

primosGemelosNoProximosAmultiplosDe6' n = [(3,5)]

Capicúas productos de dos números de dos dígitos

PorJosé A. Alonso 5-noviembre-201525-abril-2021

El número 9009 es capicúa y es producto de dos números de dos dígitos, pues 9009 = 91*99.

Definir la lista

   capicuasP2N2D :: [Int]

1	capicuasP2N2D :: [Int]

cuyos elementos son los números capicúas que son producto de 2 números de dos dígitos. Por ejemplo,

   take 5  capicuasP2N2D  ==  [121,242,252,272,323]
   length  capicuasP2N2D  ==  74
   drop 70 capicuasP2N2D  ==  [8008,8118,8448,9009]

take 5 capicuasP2N2D == [121,242,252,272,323]

length capicuasP2N2D == 74

drop 70 capicuasP2N2D == [8008,8118,8448,9009]

Soluciones

import Data.List

capicuasP2N2D :: [Int]
capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números menores que son productos de 2
-- números de dos dígitos.  
productos :: [Int]
productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

-- (esCapicua x) se verifica si x es capicúa.
esCapicua :: Int -> Bool
esCapicua x = xs == reverse xs
    where xs = show x

import Data.List

capicuasP2N2D :: [Int]

capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números menores que son productos de 2

-- números de dos dígitos.

productos :: [Int]

productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

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

esCapicua :: Int -> Bool

esCapicua x = xs == reverse xs

where xs = show x

Números muy divisibles por 3

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

Se dice que un número n es muy divisible por 3 si es divisible por 3 y sigue siendo divisible por 3 si vamos quitando dígitos por la derecha. Por ejemplo, 96060 es muy divisible por 3 porque 96060, 9606, 960, 96 y 9 son todos divisibles por 3.

Definir las funciones

   muyDivPor3             :: Integer -> Bool
   numeroMuyDivPor3Cifras :: Integer -> Integer

1 2	muyDivPor3 :: Integer -> Bool numeroMuyDivPor3Cifras :: Integer -> Integer

tales que

(muyDivPor3 n) se verifica si n es muy divisible por 3. Por ejemplo,

     muyDivPor3 96060 == True
     muyDivPor3 90616 == False

1 2	muyDivPor3 96060 == True muyDivPor3 90616 == False

(numeroMuyDivPor3CifrasC k) es la cantidad de números de k cifras muy divisibles por 3. Por ejemplo,

     numeroMuyDivPor3Cifras 5                    == 768
     numeroMuyDivPor3Cifras 7                    == 12288
     numeroMuyDivPor3Cifras (10^6) `rem` (10^6)  == 332032

numeroMuyDivPor3Cifras 5 == 768

numeroMuyDivPor3Cifras 7 == 12288

numeroMuyDivPor3Cifras (10^6) `rem` (10^6) == 332032

Soluciones

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool
muyDivPor3 n 
    | n < 10    = n `rem` 3 == 0
    | otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

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

numeroMuyDivPor3Cifras :: Integer -> Integer
numeroMuyDivPor3Cifras k = 
    genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

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

numeroMuyDivPor3Cifras2 :: Integer -> Integer
numeroMuyDivPor3Cifras2 k = 
    genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]
    where n = k*10^(k-1)

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

numeroMuyDivPor3Cifras3 :: Integer -> Integer
numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]
numeroMuyDivPor3Cifras3a 1 = [3,6,9] 
numeroMuyDivPor3Cifras3a k = 
    [10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),
              y <- [0,3..9]]

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

numeroMuyDivPor3Cifras4 :: Integer -> Integer
numeroMuyDivPor3Cifras4 1 = 3
numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

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

numeroMuyDivPor3Cifras5 :: Integer -> Integer
numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

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

--    λ> numeroMuyDivPor3Cifras 6
--    3072
--    (3.47 secs, 534,789,608 bytes)
--    λ> numeroMuyDivPor3Cifras2 6
--    2048
--    (0.88 secs, 107,883,432 bytes)
--    λ> numeroMuyDivPor3Cifras3 6
--    3072
--    (0.01 secs, 0 bytes)
--    
--    λ> numeroMuyDivPor3Cifras2 7
--    0
--    (2.57 secs, 375,999,336 bytes)
--    λ> numeroMuyDivPor3Cifras3 7
--    12288
--    (0.02 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras4 7
--    12288
--    (0.00 secs, 0 bytes)
--    λ> numeroMuyDivPor3Cifras5 7
--    12288
--    (0.01 secs, 0 bytes)
--
--    λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000
--    32032
--    (5.74 secs, 1,408,600,592 bytes)
--    λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000
--    32032
--    (0.02 secs, 0 bytes)

import Data.List (genericLength)

muyDivPor3 :: Integer -> Bool

muyDivPor3 n

| n < 10 = n `rem` 3 == 0

| otherwise = n `rem` 3 == 0 && muyDivPor3 (n `div` 10)

-- 1ª definición

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

numeroMuyDivPor3Cifras :: Integer -> Integer

numeroMuyDivPor3Cifras k =

genericLength [x | x <- [10^(k-1)..10^k-1], muyDivPor3 x]

-- 2ª definición

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

numeroMuyDivPor3Cifras2 :: Integer -> Integer

numeroMuyDivPor3Cifras2 k =

genericLength [x | x <- [n,n+3..10^k-1], muyDivPor3 x]

where n = k*10^(k-1)

-- 3ª definición

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

numeroMuyDivPor3Cifras3 :: Integer -> Integer

numeroMuyDivPor3Cifras3 k = genericLength (numeroMuyDivPor3Cifras3a k)

numeroMuyDivPor3Cifras3a :: Integer -> [Integer]

numeroMuyDivPor3Cifras3a 1 = [3,6,9]

numeroMuyDivPor3Cifras3a k =

[10*x+y | x <- numeroMuyDivPor3Cifras3a (k-1),

y <- [0,3..9]]

-- 4ª definición

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

numeroMuyDivPor3Cifras4 :: Integer -> Integer

numeroMuyDivPor3Cifras4 1 = 3

numeroMuyDivPor3Cifras4 k = 4 * numeroMuyDivPor3Cifras4 (k-1)

-- 5ª definición

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

numeroMuyDivPor3Cifras5 :: Integer -> Integer

numeroMuyDivPor3Cifras5 k = 3 * 4^(k-1)

-- Comparación de eficiencia

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

-- λ> numeroMuyDivPor3Cifras 6

-- 3072

-- (3.47 secs, 534,789,608 bytes)

-- λ> numeroMuyDivPor3Cifras2 6

-- 2048

-- (0.88 secs, 107,883,432 bytes)

-- λ> numeroMuyDivPor3Cifras3 6

-- 3072

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras2 7

-- 0

-- (2.57 secs, 375,999,336 bytes)

-- λ> numeroMuyDivPor3Cifras3 7

-- 12288

-- (0.02 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 7

-- 12288

-- (0.00 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras5 7

-- 12288

-- (0.01 secs, 0 bytes)

-- λ> numeroMuyDivPor3Cifras4 (10^5) `rem` 100000

-- 32032

-- (5.74 secs, 1,408,600,592 bytes)

-- λ> numeroMuyDivPor3Cifras5 (10^5) `rem` 100000

-- 32032

-- (0.02 secs, 0 bytes)

Soluciones

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Referencias

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico