Medio – Página 10

Subconjuntos acotados

PorJosé A. Alonso 10-noviembre-201617-noviembre-2016

Definir la función

   subconjuntosAcotados :: [a] -> Int -> [[a]]

1	subconjuntosAcotados :: [a] -> Int -> [[a]]

tal que (subconjuntosAcotados xs k) es la lista de los subconjuntos de xs con k elementos como máximo. Por ejemplo,

   λ> subconjuntosAcotados "abcd" 1
   ["a","b","c","d",""]
   λ> subconjuntosAcotados "abcd" 2
   ["ab","ac","ad","a","bc","bd","b","cd","c","d",""]
   λ> subconjuntosAcotados "abcd" 3
   ["abc","abd","ab","acd","ac","ad","a",
    "bcd","bc","bd","b","cd","c","d",""]
   λ> length (subconjuntosAcotados [1..1000] 2)
   500501
   λ> length (subconjuntosAcotados2 [1..2000] 2)
   2001001

λ> subconjuntosAcotados "abcd" 1

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

λ> subconjuntosAcotados "abcd" 2

["ab","ac","ad","a","bc","bd","b","cd","c","d",""]

λ> subconjuntosAcotados "abcd" 3

["abc","abd","ab","acd","ac","ad","a",

"bcd","bc","bd","b","cd","c","d",""]

λ> length (subconjuntosAcotados [1..1000] 2)

500501

λ> length (subconjuntosAcotados2 [1..2000] 2)

2001001

Soluciones

import Data.List (subsequences)

-- 1ª definición
subconjuntosAcotados1 :: [a] -> Int -> [[a]]
subconjuntosAcotados1 xs k =
  [ys | ys <- subsequences xs
      , length ys <= k]

-- 2ª definición
subconjuntosAcotados2 :: [a] -> Int -> [[a]]
subconjuntosAcotados2 _ 0  = [[]]
subconjuntosAcotados2 [] _ = [[]]
subconjuntosAcotados2 (x:xs) k =
  [x:ys | ys <- subconjuntosAcotados2 xs (k-1)]
  ++ subconjuntosAcotados2 xs k

-- Comparación de eficiencia
--    λ> length (subconjuntosAcotados1 [1..25] 2)
--    326
--    (10.48 secs, 6,968,637,480 bytes)
--    λ> length (subconjuntosAcotados2 [1..25] 2)
--    326
--    (0.00 secs, 0 bytes)

import Data.List (subsequences)

-- 1ª definición

subconjuntosAcotados1 :: [a] -> Int -> [[a]]

subconjuntosAcotados1 xs k =

[ys | ys <- subsequences xs

, length ys <= k]

-- 2ª definición

subconjuntosAcotados2 :: [a] -> Int -> [[a]]

subconjuntosAcotados2 _ 0 = [[]]

subconjuntosAcotados2 [] _ = [[]]

subconjuntosAcotados2 (x:xs) k =

[x:ys | ys <- subconjuntosAcotados2 xs (k-1)]

++ subconjuntosAcotados2 xs k

-- Comparación de eficiencia

-- λ> length (subconjuntosAcotados1 [1..25] 2)

-- 326

-- (10.48 secs, 6,968,637,480 bytes)

-- λ> length (subconjuntosAcotados2 [1..25] 2)

-- 326

-- (0.00 secs, 0 bytes)

Variación de la conjetura de Goldbach

PorJosé A. Alonso 9-noviembre-201625-abril-2021

La conjetura de Goldbach afirma que

Todo número entero mayor que 5 se puede escribir como suma de tres números primos.

En este ejercicio consideraremos la variación consistente en exigir que los tres sumandos sean distintos.

Definir las funciones

   sumas3PrimosDistintos      :: Int -> [(Int,Int,Int)]
   conKsumas3PrimosDistintos  :: Int -> Int -> [Int]
   noSonSumas3PrimosDistintos :: Int -> [Int]

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

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

noSonSumas3PrimosDistintos :: Int -> [Int]

tales que

(sumas3PrimosDistintos n) es la lista de las descomposiciones decrecientes de n como tres primos distintos. Por ejemplo,

   sumas3PrimosDistintos 26  ==  [(13,11,2),(17,7,2),(19,5,2)]
   sumas3PrimosDistintos 18  ==  [(11,5,2),(13,3,2)]
   sumas3PrimosDistintos 10  ==  [(5,3,2)]
   sumas3PrimosDistintos 11  ==  []

sumas3PrimosDistintos 26 == [(13,11,2),(17,7,2),(19,5,2)]

sumas3PrimosDistintos 18 == [(11,5,2),(13,3,2)]

sumas3PrimosDistintos 10 == [(5,3,2)]

sumas3PrimosDistintos 11 == []

(conKsumas3PrimosDistintos k n) es la lista de los números menores o iguales que n que se pueden escribir en k forma distintas como suma de tres primos distintos. Por ejemplo,

   conKsumas3PrimosDistintos 3 99  ==  [26,27,29,32,36,42,46,48,54,58,60]
   conKsumas3PrimosDistintos 2 99  ==  [18,20,21,22,23,24,25,28,30,34,64,70]
   conKsumas3PrimosDistintos 1 99  ==  [10,12,14,15,16,19,40]
   conKsumas3PrimosDistintos 0 99  ==  [11,13,17]

conKsumas3PrimosDistintos 3 99 == [26,27,29,32,36,42,46,48,54,58,60]

conKsumas3PrimosDistintos 2 99 == [18,20,21,22,23,24,25,28,30,34,64,70]

conKsumas3PrimosDistintos 1 99 == [10,12,14,15,16,19,40]

conKsumas3PrimosDistintos 0 99 == [11,13,17]

(noSonSumas3PrimosDistintos n) es la lista de los números menores o iguales que n que no se pueden escribir como suma de tres primos distintos. Por ejemplo,

   noSonSumas3PrimosDistintos 99   ==  [11,13,17]
   noSonSumas3PrimosDistintos 500  ==  [11,13,17]

1 2	noSonSumas3PrimosDistintos 99 == [11,13,17] noSonSumas3PrimosDistintos 500 == [11,13,17]

Soluciones

import Data.Numbers.Primes

sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]
sumas3PrimosDistintos n =
  [(a,b,c) | a <- takeWhile (<=n-5) primes
           , b <- takeWhile (<a) primes
           , let c = n - a - b
           , c < b
           , isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]
conKsumas3PrimosDistintos k n =
  [x | x <- [10..n]
     , length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]
noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

import Data.Numbers.Primes

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

sumas3PrimosDistintos n =

[(a,b,c) | a <- takeWhile (<=n-5) primes

, b <- takeWhile (<a) primes

, let c = n - a - b

, c < b

, isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

conKsumas3PrimosDistintos k n =

[x | x <- [10..n]

, length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]

noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

Referencias

Basado en el artículo Derivaciones de la conjetura de Goldbach de Claudio Meller en el blog Números y algo más.

Primo anterior

PorJosé A. Alonso 7-noviembre-201614-noviembre-2016

Definir la función

   primoAnterior :: Integer -> Integer

1	primoAnterior :: Integer -> Integer

tal que (primoAnterior n) es el mayor primo menor que n (donde n > 2). Por ejemplo,

   primoAnterior 10     ==  7
   primoAnterior 17     ==  13
   primoAnterior 30     ==  29
   primoAnterior 2016   ==  2011
   primoAnterior 15726  ==  15683

primoAnterior 10 == 7

primoAnterior 17 == 13

primoAnterior 30 == 29

primoAnterior 2016 == 2011

primoAnterior 15726 == 15683

Calcular el menor número cuya distancia a su primo anterior es mayor que 40.

Soluciones

import Data.Numbers.Primes ( isPrime
                           , primes
                           )

-- 1ª definición
primoAnterior1 :: Integer -> Integer
primoAnterior1 n =
  last (takeWhile (<n) primes)

-- 2ª definición
primoAnterior2 :: Integer -> Integer
primoAnterior2 3 = 2
primoAnterior2 n =
  head [x | x <- [a,a-2..]
          , isPrime x]
  where a | even n    = n-1
          | otherwise = n-2

-- Comparación de eficiencia  
--    λ> primoAnterior1 3000000
--    2999999
--    (1.80 secs, 1,148,572,848 bytes)
--    λ> primoAnterior2 3000000
--    2999999
--    (0.00 secs, 0 bytes)
--    
--    λ> head [n | n <- [3..], n - primoAnterior1 n > 34]
--    9586
--    (28.08 secs, 14,396,008,560 bytes)
--    λ> head [n | n <- [3..], n - primoAnterior2 n > 34]
--    9586
--    (1.10 secs, 625,247,632 bytes)

-- El cálculo es
--    λ> head [n | n <- [3..], n - primoAnterior2 n > 40]
--    15724

import Data.Numbers.Primes ( isPrime

, primes

)

-- 1ª definición

primoAnterior1 :: Integer -> Integer

primoAnterior1 n =

last (takeWhile (<n) primes)

-- 2ª definición

primoAnterior2 :: Integer -> Integer

primoAnterior2 3 = 2

primoAnterior2 n =

head [x | x <- [a,a-2..]

, isPrime x]

where a | even n = n-1

| otherwise = n-2

-- Comparación de eficiencia

-- λ> primoAnterior1 3000000

-- 2999999

-- (1.80 secs, 1,148,572,848 bytes)

-- λ> primoAnterior2 3000000

-- 2999999

-- (0.00 secs, 0 bytes)

-- λ> head [n | n <- [3..], n - primoAnterior1 n > 34]

-- 9586

-- (28.08 secs, 14,396,008,560 bytes)

-- λ> head [n | n <- [3..], n - primoAnterior2 n > 34]

-- 9586

-- (1.10 secs, 625,247,632 bytes)

-- El cálculo es

-- λ> head [n | n <- [3..], n - primoAnterior2 n > 40]

-- 15724

Primos de Kamenetsky

PorJosé A. Alonso 4-noviembre-201611-noviembre-2016

Un número primo se dice que es un primo de Kamenetsky si al anteponerlo cualquier dígito se obtiene un número compuesto. Por ejemplo, el 5 es un primo de Kamenetsky ya que 15, 25, 35, 45, 55, 65, 75, 85 y 95 son compuestos. También lo es 149 ya que 1149, 2149, 3149, 4149, 5149, 6149, 7149, 8149 y 9149 son compuestos.

Definir la sucesión

   primosKamenetsky :: [Integer]

1	primosKamenetsky :: [Integer]

tal que sus elementos son los números primos de Kamenetsky. Por ejemplo,

   take 5 primosKamenetsky  ==  [2,5,149,401,509]

1	take 5 primosKamenetsky == [2,5,149,401,509]

Soluciones

import Data.Numbers.Primes (isPrime, primes)

primosKamenetsky :: [Integer]
primosKamenetsky =
  [x | x <- primes
     , esKamenetsky x] 

esKamenetsky :: Integer -> Bool
esKamenetsky x =
  all (not . isPrime) [read (d:xs) | d <- "123456789"]
  where xs = show x

import Data.Numbers.Primes (isPrime, primes)

primosKamenetsky :: [Integer]

primosKamenetsky =

[x | x <- primes

, esKamenetsky x]

esKamenetsky :: Integer -> Bool

esKamenetsky x =

all (not . isPrime) [read (d:xs) | d <- "123456789"]

where xs = show x

Referencias

Sucesión A155762 de la OEIS.
Anteponer un dígito a un primo en «Números y algo más».

Números de Harshad hereditarios

PorJosé A. Alonso 3-noviembre-201610-noviembre-2016

Un número de Harshad es un entero divisible entre la suma de sus dígitos. Por ejemplo, 201 es un número de Harshad porque es divisible por 3 (la suma de sus dígitos). Cuando se elimina el último dígito de 201 se obtiene 20 que también es un número de Harshad. Cuando se elimina el último dígito de 20 se obtiene 2 que también es un número de Harshad. Los números como el 201 que son de Harshad y que los números obtenidos eliminando sus últimos dígitos siguen siendo de Harshad se llaman números de Harshad hereditarios por la derecha. Definir la función

   numeroHHD :: Int -> Bool

1	numeroHHD :: Int -> Bool

tal que (numeroHHD n) se verifica si n es un número de Harshad hereditario por la derecha. Por ejemplo,

   numeroHHD 201  ==  True
   numeroHHD 140  ==  False
   numeroHHD 1104 ==  False

numeroHHD 201 == True

numeroHHD 140 == False

numeroHHD 1104 == False

Calcular el mayor número de Harshad hereditario por la derecha con tres dígitos.

Soluciones

-- (numeroH n) se verifica si n es un número de Harshad.
--    numeroH 201  ==  True
numeroH :: Int -> Bool
numeroH n = rem n (sum (digitos n)) == 0

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

numeroHHD :: Int -> Bool 
numeroHHD n | n < 10    = True
            | otherwise = numeroH n && numeroHHD (div n 10) 

-- El cálculo es
--    ghci> head [n | n <- [999,998..100], numeroHHD n]
--    902

-- (numeroH n) se verifica si n es un número de Harshad.

-- numeroH 201 == True

numeroH :: Int -> Bool

numeroH n = rem n (sum (digitos n)) == 0

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

-- digitos 201 == [2,0,1]

digitos :: Int -> [Int]

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

numeroHHD :: Int -> Bool

numeroHHD n | n < 10 = True

| otherwise = numeroH n && numeroHHD (div n 10)

-- El cálculo es

-- ghci> head [n | n <- [999,998..100], numeroHHD n]

-- 902

Triángulos geométricos

PorJosé A. Alonso 2-noviembre-20169-noviembre-2016

Un triángulo geométrico es un triángulo de lados enteros, representados por la terna (a,b,c) tal que a ≤ b ≤ c y están en progresión geométrica, es decir, b^2 = a*c. Por ejemplo, un triángulo de lados a = 144, b = 156 y c = 169.

Definir la función

   numeroTG :: Integer -> Int

1	numeroTG :: Integer -> Int

tal que (numeroTG n) es el número de triángulos geométricos de perímetro menor o igual que n. Por ejemplo

    numeroTG 10  == 3
    numeroTG 100 == 42
    numeroTG 200 == 91

numeroTG 10 == 3

numeroTG 100 == 42

numeroTG 200 == 91

Nota: Los triángulos geométricos de perímetro menor o igual que 20 son

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

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

Se observa que (1,2,4) aunque cumple que 1+2+4 <= 20 y 2^2 = 1*4 no pertenece a la lista ya que 1+2 > 4 y, por tanto, no hay ningún triángulo cuyos lados midan 1, 2 y 4.

Soluciones

-- 1ª definición:
numeroTG :: Integer -> Int
numeroTG n = 
    length [(a,b,c) | c <- [1..n]
                    , b <- [1..c]
                    , a <- [1..b]
                    , a+b > c
                    , a+b+c <= n
                    , b^2 == a*c
                    ]

-- 2ª definición:
numeroTG2 :: Integer -> Int
numeroTG2 n = 
    length [(a,b,c) | c <- [1..n]
                    , b <- [1..c]
                    , b^2 `rem` c == 0
                    , let a = b^2 `div` c
                    , a+b > c
                    , a+b+c <= n
                    ]

-- Comparación de eficiencia:
--    λ> numeroTG 300
--    143
--    (2.40 secs, 1,496,824,720 bytes)
--    λ> numeroTG2 300
--    143
--    (0.05 secs, 40,908,568 bytes)

-- 1ª definición:

numeroTG :: Integer -> Int

numeroTG n =

length [(a,b,c) | c <- [1..n]

, b <- [1..c]

, a <- [1..b]

, a+b > c

, a+b+c <= n

, b^2 == a*c

]

-- 2ª definición:

numeroTG2 :: Integer -> Int

numeroTG2 n =

length [(a,b,c) | c <- [1..n]

, b <- [1..c]

, b^2 `rem` c == 0

, let a = b^2 `div` c

, a+b > c

, a+b+c <= n

]

-- Comparación de eficiencia:

-- λ> numeroTG 300

-- 143

-- (2.40 secs, 1,496,824,720 bytes)

-- λ> numeroTG2 300

-- 143

-- (0.05 secs, 40,908,568 bytes)

Referencia

El ejercicio está basado en el problema 370 del proyecto Euler.

Caminos en una retícula

PorJosé A. Alonso 26-mayo-20162-junio-2016

El problema de los caminos en una retícula consiste en, dada una retícula rectangular con m filas y n columnas, determinar todos los caminos para ir desde el vértice inferior izquierdo hasta el vértice superior derecho donde los movimientos permitidos son mover hacia el siguiente vértice a la derecha o arriba.

Por ejemplo, en la siguiente retícula un posible camino es el indicado en rojo.

Para representar los caminos se definen los siguientes tipos de datos:

    data Direccion = D | A deriving (Show, Eq)
    type Camino = [Direccion]

1 2	data Direccion = D \| A deriving (Show, Eq) type Camino = [Direccion]

Por tanto, el camino de la figura anterior se representa por la lista [D,D,A,D,A].

Definir las funciones

   caminos  :: Int -> Int -> [Camino]
   nCaminos :: Int -> Int -> Integer

1 2	caminos :: Int -> Int -> [Camino] nCaminos :: Int -> Int -> Integer

tales que

(caminos m n) es la lista de los caminos en una retícula rectangular con m filas y n columnas. Por ejemplo,

     λ> caminos 2 2
     [[A,A,D,D],[A,D,A,D],[A,D,D,A],[D,A,A,D],[D,A,D,A],[D,D,A,A]]
     λ> caminos 1 3
     [[A,A,A,D],[A,A,D,A],[A,D,A,A],[D,A,A,A]]
     λ> caminos 2 3
     [[A,A,A,D,D],[A,A,D,A,D],[A,A,D,D,A],[A,D,A,A,D],[A,D,A,D,A],[A,D,D,A,A],
      [D,A,A,A,D],[D,A,A,D,A],[D,A,D,A,A],[D,D,A,A,A]]

λ> caminos 2 2

[[A,A,D,D],[A,D,A,D],[A,D,D,A],[D,A,A,D],[D,A,D,A],[D,D,A,A]]

λ> caminos 1 3

[[A,A,A,D],[A,A,D,A],[A,D,A,A],[D,A,A,A]]

λ> caminos 2 3

[[A,A,A,D,D],[A,A,D,A,D],[A,A,D,D,A],[A,D,A,A,D],[A,D,A,D,A],[A,D,D,A,A],

[D,A,A,A,D],[D,A,A,D,A],[D,A,D,A,A],[D,D,A,A,A]]

(nCaminos m n) es el número de los caminos en una retícula rectangular con m filas y n columnas. Por ejemplo,

     nCaminos 2 2  ==  6
     nCaminos 1 3  ==  4
     nCaminos 2 3  ==  10
     length (show (nCaminos 20000 30000))  ==  14612
     length (show (nCaminos 30000 20000))  ==  14612

nCaminos 2 2 == 6

nCaminos 1 3 == 4

nCaminos 2 3 == 10

length (show (nCaminos 20000 30000)) == 14612

length (show (nCaminos 30000 20000)) == 14612

Soluciones

import Data.List (genericLength)

data Direccion = D | A deriving (Show, Eq)

type Camino = [Direccion]

-- Definición de caminos
-- =====================

caminos :: Int -> Int -> [Camino]
caminos 0 n = [replicate n A]
caminos m 0 = [replicate m D]
caminos m n = [A:xs | xs <- caminos m (n-1)] ++
              [D:xs | xs <- caminos (m-1) n]

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

nCaminos1 :: Int -> Int -> Integer
nCaminos1 m n = genericLength (caminos m n)

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

nCaminos2 :: Int -> Int -> Integer
nCaminos2 0 n = 1
nCaminos2 m 0 = 1
nCaminos2 m n = nCaminos2 m (n-1) + nCaminos2 (m-1) n

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

-- Los caminos desde (0,0) a (m,n) son las permutaciones con repetición
-- de m veces la D y n veces la A. Por tanto, su número es
--    (m+n)! / m!*n!

nCaminos3 :: Int -> Int -> Integer
nCaminos3 m n = 
    fact (m+n) `div` (fact m * fact n)

fact :: Int -> Integer
fact n = product [1..fromIntegral n]

-- 4ª solución de nCaminos
-- =======================

nCaminos4 :: Int -> Int -> Integer
nCaminos4 m n = 
    product [a+1..a+b] `div` product [2..b]
    where m' = fromIntegral m
          n' = fromIntegral n
          a  = max m' n'
          b  = min m' n'

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

--    λ> nCaminos1 10 10
--    184756
--    (3.50 secs, 656,909,648 bytes)
--    λ> nCaminos2 10 10
--    184756
--    (0.50 secs, 47,330,272 bytes)
--    λ> nCaminos3 10 10
--    184756
--    (0.01 secs, 0 bytes)
--    λ> nCaminos4 10 10
--    184756
--    (0.01 secs, 0 bytes)
-- 
--    λ> nCaminos2 10 15
--    3268760
--    (8.83 secs, 1,142,623,080 bytes)
--    λ> nCaminos3 10 15
--    3268760
--    (0.01 secs, 0 bytes)
--    λ> nCaminos4 10 15
--    3268760
--    (0.00 secs, 0 bytes)
--
--    λ> let n = 2*10^4 
--    (0.01 secs, 0 bytes)
--    λ> length (show (nCaminos3 n n))
--    12039
--    (8.41 secs, 2,369,767,480 bytes)
--    λ> length (show (nCaminos4 n n))
--    12039
--    (2.98 secs, 833,386,648 bytes)

import Data.List (genericLength)

data Direccion = D | A deriving (Show, Eq)

type Camino = [Direccion]

-- Definición de caminos

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

caminos :: Int -> Int -> [Camino]

caminos 0 n = [replicate n A]

caminos m 0 = [replicate m D]

caminos m n = [A:xs | xs <- caminos m (n-1)] ++

[D:xs | xs <- caminos (m-1) n]

-- 1ª definición de nCaminos

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

nCaminos1 :: Int -> Int -> Integer

nCaminos1 m n = genericLength (caminos m n)

-- 2ª definición de nCaminos

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

nCaminos2 :: Int -> Int -> Integer

nCaminos2 0 n = 1

nCaminos2 m 0 = 1

nCaminos2 m n = nCaminos2 m (n-1) + nCaminos2 (m-1) n

-- 3ª definición de nCaminos

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

-- Los caminos desde (0,0) a (m,n) son las permutaciones con repetición

-- de m veces la D y n veces la A. Por tanto, su número es

-- (m+n)! / m!*n!

nCaminos3 :: Int -> Int -> Integer

nCaminos3 m n =

fact (m+n) `div` (fact m * fact n)

fact :: Int -> Integer

fact n = product [1..fromIntegral n]

-- 4ª solución de nCaminos

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

nCaminos4 :: Int -> Int -> Integer

nCaminos4 m n =

product [a+1..a+b] `div` product [2..b]

where m' = fromIntegral m

n' = fromIntegral n

a = max m' n'

b = min m' n'

-- Comparación de eficiencia

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

-- λ> nCaminos1 10 10

-- 184756

-- (3.50 secs, 656,909,648 bytes)

-- λ> nCaminos2 10 10

-- 184756

-- (0.50 secs, 47,330,272 bytes)

-- λ> nCaminos3 10 10

-- 184756

-- (0.01 secs, 0 bytes)

-- λ> nCaminos4 10 10

-- 184756

-- (0.01 secs, 0 bytes)

-- λ> nCaminos2 10 15

-- 3268760

-- (8.83 secs, 1,142,623,080 bytes)

-- λ> nCaminos3 10 15

-- 3268760

-- (0.01 secs, 0 bytes)

-- λ> nCaminos4 10 15

-- 3268760

-- (0.00 secs, 0 bytes)

-- λ> let n = 2*10^4

-- (0.01 secs, 0 bytes)

-- λ> length (show (nCaminos3 n n))

-- 12039

-- (8.41 secs, 2,369,767,480 bytes)

-- λ> length (show (nCaminos4 n n))

-- 12039

-- (2.98 secs, 833,386,648 bytes)

Centro de gravedad de una lista

PorJosé A. Alonso 25-mayo-201626-marzo-2022

Se dice que una lista de números xs es equilibrada si existe una posición k tal que la suma de los elementos de xs en las posiciones menores que k es igual a la de los elementos de xs en las posiciones mayores que k. La posición k se llama el centro de gravedad de xs. Por ejemplo, la lista [1,3,4,5,-2,1] es equilibrada, y su centro de gravedad es 2, ya que la suma de [1,3] es igual a la de [5,-2,1]. En cambio, la lista [1,6,4,5,-2,1] no tiene centro de gravedad.

Definir la función

   centro :: (Num a, Eq a) => [a] -> Maybe Int

1	centro :: (Num a, Eq a) => [a] -> Maybe Int

tal que (centro xs) es justo el centro e gravedad de xs, si la lista xs es equilibrada y Nothing en caso contrario. Por ejemplo,

   centro [1,3,4,5,-2,1]           ==  Just 2
   centro [1,6,4,5,-2,1]           ==  Nothing
   centro [1,2,3,4,3,2,1]          ==  Just 3
   centro [1,100,50,-51,1,1]       ==  Just 1
   centro [1,2,3,4,5,6]            ==  Nothing
   centro [20,10,30,10,10,15,35]   ==  Just 3
   centro [20,10,-80,10,10,15,35]  ==  Just 0
   centro [10,-80,10,10,15,35,20]  ==  Just 6
   centro [0,0,0,0,0]              ==  Just 0
   centro [-1,-2,-3,-4,-3,-2,-1]   ==  Just 3

centro [1,3,4,5,-2,1] == Just 2

centro [1,6,4,5,-2,1] == Nothing

centro [1,2,3,4,3,2,1] == Just 3

centro [1,100,50,-51,1,1] == Just 1

centro [1,2,3,4,5,6] == Nothing

centro [20,10,30,10,10,15,35] == Just 3

centro [20,10,-80,10,10,15,35] == Just 0

centro [10,-80,10,10,15,35,20] == Just 6

centro [0,0,0,0,0] == Just 0

centro [-1,-2,-3,-4,-3,-2,-1] == Just 3

Soluciones

import Data.List (inits, tails)
import Data.Maybe (listToMaybe)

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

centro1 :: (Num a, Eq a) => [a] -> Maybe Int
centro1 xs 
    | null ns   = Nothing
    | otherwise = Just (head ns)
    where ns = [n | n <- [0..length xs - 1],
                    let (ys,_:zs) = splitAt n xs,
                    sum ys == sum zs]

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

centro2 :: (Num a, Eq a) => [a] -> Maybe Int
centro2 xs = aux 0 0 (sum xs) xs where
    aux _ _ _ [] = Nothing
    aux k i d (z:zs) | i == d - z = Just k
                     | otherwise  = aux (k + 1) (i + z) (d - z) zs

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

centro3 :: (Num a, Eq a) => [a] -> Maybe Int
centro3 xs =
  listToMaybe [ k | (k,ys,_:zs) <- zip3 [0..] (inits xs) (tails xs)
                  , sum ys == sum zs]

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

--    λ> let xs = [1..3000] in centro1 (xs ++ (0:xs))
--    Just 3000
--    (2.70 secs, 2,088,881,728 bytes)
--    λ> let xs = [1..3000] in centro2 (xs ++ (0:xs))
--    Just 3000
--    (0.03 secs, 0 bytes)
--    λ> let xs = [1..3000] in centro3 (xs ++ (0:xs))
--    Just 3000
--    (2.34 secs, 1,727,569,688 bytes)

import Data.List (inits, tails)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

centro1 :: (Num a, Eq a) => [a] -> Maybe Int

centro1 xs

| null ns = Nothing

| otherwise = Just (head ns)

where ns = [n | n <- [0..length xs - 1],

let (ys,_:zs) = splitAt n xs,

sum ys == sum zs]

-- 2ª solución

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

centro2 :: (Num a, Eq a) => [a] -> Maybe Int

centro2 xs = aux 0 0 (sum xs) xs where

aux _ _ _ [] = Nothing

aux k i d (z:zs) | i == d - z = Just k

| otherwise = aux (k + 1) (i + z) (d - z) zs

-- 3ª solución

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

centro3 :: (Num a, Eq a) => [a] -> Maybe Int

centro3 xs =

listToMaybe [ k | (k,ys,_:zs) <- zip3 [0..] (inits xs) (tails xs)

, sum ys == sum zs]

-- Comparación de eficiencia

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

-- λ> let xs = [1..3000] in centro1 (xs ++ (0:xs))

-- Just 3000

-- (2.70 secs, 2,088,881,728 bytes)

-- λ> let xs = [1..3000] in centro2 (xs ++ (0:xs))

-- Just 3000

-- (0.03 secs, 0 bytes)

-- λ> let xs = [1..3000] in centro3 (xs ++ (0:xs))

-- Just 3000

-- (2.34 secs, 1,727,569,688 bytes)

Sucesión duplicadora

PorJosé A. Alonso 16-mayo-201625-abril-2021

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª solución
duplicadora :: Integer -> [Integer]
duplicadora x =
    reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
    reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª solución

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Problema de las puertas

PorJosé A. Alonso 13-mayo-201625-abril-2021

Un hotel dispone de n habitaciones y n camareros. Los camareros tienen la costumbre de cambiar de estado las puestas (es decir, abrir las cerradas y cerrar las abiertas). El proceso es el siguiente:

Inicialmente todas las puertas están cerradas.
El primer camarero cambia de estado las puertas de todas las habitaciones.
El segundo cambia de estado de las puertas de las habitaciones pares.
El tercero cambia de estado todas las puertas que son múltiplos de 3.
El cuarto cambia de estado todas las puertas que son múltiplos de 4
Así, hasta que ha pasado el último camarero.

Por ejemplo, para n = 5

   Pase    | Puerta 1 | Puerta 2 | Puerta 3 | Puerta 4 | Puerta 5
   --------+----------+----------+----------+----------+----------
   Inicial | Cerrada  | Cerrada  | Cerrada  | Cerrada  | Cerrada
   Pase 1  | Abierta  | Abierta  | Abierta  | Abierta  | Abierta
   Pase 2  | Abierta  | Cerrada  | Abierta  | Cerrada  | Abierta
   Pase 3  | Abierta  | Cerrada  | Cerrada  | Cerrada  | Abierta
   Pase 4  | Abierta  | Cerrada  | Cerrada  | Abierta  | Abierta
   Pase 5  | Abierta  | Cerrada  | Cerrada  | Abierta  | Cerrada

--------+----------+----------+----------+----------+----------

Los estados de las puertas se representan por el siguiente tipo de datos

   data Estado = Abierta | Cerrada 
                 deriving (Eq, Show)

1 2	data Estado = Abierta \| Cerrada deriving (Eq, Show)

Definir la función

   final :: Int -> [Estado]

1	final :: Int -> [Estado]

tal que (final n) es la lista de los estados de las n puertas después
de que hayan pasado los n camareros. Por
ejemplo,

   ghci> final 5
   [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
   ghci> final 7
   [Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

ghci> final 5

[Abierta,Cerrada,Cerrada,Abierta,Cerrada]

ghci> final 7

[Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

Soluciones

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

data Estado = Abierta | Cerrada 
              deriving (Eq, Show)
 
cambia Abierta = Cerrada
cambia Cerrada = Abierta

-- (inicial n) es el estado inicial para el problema de las n
-- habitaciones. Por ejemplo,
--    inicial 5  ==  [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]
inicial :: Int -> [Estado]
inicial n = replicate n Cerrada

-- (pase k es) es la lista de los estados de las puertas después de pasar el
-- camarero k que las encuentra en los estados es. Por ejemplo,
--    ghci> pase 1 (inicial 5)
--    [Abierta,Abierta,Abierta,Abierta,Abierta]
--    ghci> pase 2 it
--    [Abierta,Cerrada,Abierta,Cerrada,Abierta]
--    ghci> pase 3 it
--    [Abierta,Cerrada,Cerrada,Cerrada,Abierta]
--    ghci> pase 4 it
--    [Abierta,Cerrada,Cerrada,Abierta,Abierta]
--    ghci> pase 5 it
--    [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
pase :: [Estado] -> Int -> [Estado] 
pase es k = zipWith cambiaK  es[1..] 
  where cambiaK e n | n `mod` k == 0 = cambia e
                    | otherwise      = e
               
final :: Int -> [Estado]
final n = aux [1..n] (inicial n) 
    where aux []     es = es  
          aux (k:ks) es = aux ks (pase es k)

-- 2ª solución (con foldl')
-- ========================

final2 :: Int -> [Estado]
final2 n = foldl pase (inicial n) [1..n] 

-- 3ª definición (basada en los cambios de cada posición)
-- ======================================================

final3 :: Int -> [Estado]
final3 n = map f [1..n]
    where f x | even (length (divisores x)) = Cerrada
              | otherwise                   = Abierta

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

-- 4ª definición (basada en posiciones de abiertas)
-- ================================================

-- En primer lugar, vamos a determinar la lista de las posiciones
-- (comenzando a contar en 1) de las puertas que quedan abierta en el
-- problema de las n puertas. 
posicionesAbiertas :: Int -> [Int]
posicionesAbiertas n = 
    [x | (x,y) <- zip [1..] (final n), y == Abierta]

-- Al calcularlas,
--    ghci> posicionesAbiertas 200
--    [1,4,9,16,25,36,49,64,81,100,121,144,169,196]
-- Se observa las que quedan abiertas son las que sus posiciones son
-- cuadrados perfectos. Usando esta observación se construye la
-- siguiente definición

final4 :: Int -> [Estado]
final4 n = aux [1..n] [k*k | k <- [1..]] 
    where aux (x:xs) (y:ys) | x == y  =  Abierta : aux xs ys
          aux (x:xs) ys               =  Cerrada : aux xs ys
          aux []     _                =  []

-- 1ª solución

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

data Estado = Abierta | Cerrada

deriving (Eq, Show)

cambia Abierta = Cerrada

cambia Cerrada = Abierta

-- (inicial n) es el estado inicial para el problema de las n

-- habitaciones. Por ejemplo,

-- inicial 5 == [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]

inicial :: Int -> [Estado]

inicial n = replicate n Cerrada

-- (pase k es) es la lista de los estados de las puertas después de pasar el

-- camarero k que las encuentra en los estados es. Por ejemplo,

-- ghci> pase 1 (inicial 5)

-- [Abierta,Abierta,Abierta,Abierta,Abierta]

-- ghci> pase 2 it

-- [Abierta,Cerrada,Abierta,Cerrada,Abierta]

-- ghci> pase 3 it

-- [Abierta,Cerrada,Cerrada,Cerrada,Abierta]

-- ghci> pase 4 it

-- [Abierta,Cerrada,Cerrada,Abierta,Abierta]

-- ghci> pase 5 it

-- [Abierta,Cerrada,Cerrada,Abierta,Cerrada]

pase :: [Estado] -> Int -> [Estado]

pase es k = zipWith cambiaK es[1..]

where cambiaK e n | n `mod` k == 0 = cambia e

| otherwise = e

final :: Int -> [Estado]

final n = aux [1..n] (inicial n)

where aux [] es = es

aux (k:ks) es = aux ks (pase es k)

-- 2ª solución (con foldl')

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

final2 :: Int -> [Estado]

final2 n = foldl pase (inicial n) [1..n]

-- 3ª definición (basada en los cambios de cada posición)

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

final3 :: Int -> [Estado]

final3 n = map f [1..n]

where f x | even (length (divisores x)) = Cerrada

| otherwise = Abierta

divisores :: Int -> [Int]

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

-- 4ª definición (basada en posiciones de abiertas)

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

-- En primer lugar, vamos a determinar la lista de las posiciones

-- (comenzando a contar en 1) de las puertas que quedan abierta en el

-- problema de las n puertas.

posicionesAbiertas :: Int -> [Int]

posicionesAbiertas n =

[x | (x,y) <- zip [1..] (final n), y == Abierta]

-- Al calcularlas,

-- ghci> posicionesAbiertas 200

-- [1,4,9,16,25,36,49,64,81,100,121,144,169,196]

-- Se observa las que quedan abiertas son las que sus posiciones son

-- cuadrados perfectos. Usando esta observación se construye la

-- siguiente definición

final4 :: Int -> [Estado]

final4 n = aux [1..n] [k*k | k <- [1..]]

where aux (x:xs) (y:ys) | x == y = Abierta : aux xs ys

aux (x:xs) ys = Cerrada : aux xs ys

aux [] _ = []

Densidad de números no monótonos

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

Un número entero positivo se dice que es

creciente si cada uno de sus dígitos es menor o igual que el que está a su derecha; por ejemplo, 134479.
decreciente si cada uno de sus dígitos es menor o igual que el que está a su derecha; por ejemplo, 664210.
no monótono si no es creciente ni decreciente; por ejemplo, 155369.

Para cada entero positivo n, la densidad números no monótonos hasta n es el cociente entre la cantidad de n números no monótonos entre menores o iguales que n y el número n. Por ejemplo, hasta 150 hay 19 números no monótonos (101, 102, 103, 104, 105, 106, 107, 108, 109, 120, 121, 130, 131, 132, 140, 141, 142, 143 y 150); por tanto, la densidad hasta 150 es 19/150 = 0.12666667

Definir las siguientes funciones

   densidad              :: Integer -> Float
   menorConDensidadMayor :: Float -> Integer

1 2	densidad :: Integer -> Float menorConDensidadMayor :: Float -> Integer

tales que

(densidad n) es la densidad de números no monótonos hasta n. Por ejemplo,

     densidad 100  ==  0.0
     densidad 200  ==  0.265
     densidad 400  ==  0.4375
     densidad 800  ==  0.53375

densidad 100 == 0.0

densidad 200 == 0.265

densidad 400 == 0.4375

densidad 800 == 0.53375

(menorConDensidadMayor x) es el menor número n tal que la densidad de números no monótonos hasta n es mayor o igual que x. Por ejemplo,

     menorConDensidadMayor 0.5   ==  538
     densidad 537                ==  0.49906892
     densidad 538                ==  0.5
     menorConDensidadMayor 0.9   ==  21780
     densidad 21779              ==  0.8999954
     densidad 21780              ==  0.9
     menorConDensidadMayor 0.99  ==  1586996

menorConDensidadMayor 0.5 == 538

densidad 537 == 0.49906892

densidad 538 == 0.5

menorConDensidadMayor 0.9 == 21780

densidad 21779 == 0.8999954

densidad 21780 == 0.9

menorConDensidadMayor 0.99 == 1586996

Soluciones

import Data.List (genericLength, sort)

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

densidad :: Integer -> Float
densidad n = 
    genericLength [x | x <- [1..n], esNoMonotono x] / fromIntegral n

esNoMonotono :: Integer -> Bool
esNoMonotono x = not (esCreciente x) && not (esDecreciente x)

esCreciente :: Integer -> Bool
esCreciente x = show x == sort (show x)

esDecreciente :: Integer -> Bool
esDecreciente x = reverse (show x) == sort (show x)

menorConDensidadMayor :: Float -> Integer 
menorConDensidadMayor x  = 
    buscaProporcion x (filter esNoMonotono [1..])
    where buscaProporcion x = 
              snd . head . filter condicion . zip [1..]
              where condicion (a,b) = a >= x * fromIntegral b

import Data.List (genericLength, sort)

-- 1ª definición

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

densidad :: Integer -> Float

densidad n =

genericLength [x | x <- [1..n], esNoMonotono x] / fromIntegral n

esNoMonotono :: Integer -> Bool

esNoMonotono x = not (esCreciente x) && not (esDecreciente x)

esCreciente :: Integer -> Bool

esCreciente x = show x == sort (show x)

esDecreciente :: Integer -> Bool

esDecreciente x = reverse (show x) == sort (show x)

menorConDensidadMayor :: Float -> Integer

menorConDensidadMayor x =

buscaProporcion x (filter esNoMonotono [1..])

where buscaProporcion x =

snd . head . filter condicion . zip [1..]

where condicion (a,b) = a >= x * fromIntegral b

Número de divisiones en el algoritmo de Euclides

PorJosé A. Alonso 5-mayo-201612-mayo-2016

Dados dos números naturales, a y b, es posible calcular su máximo común divisor mediante el Algoritmo de Euclides. Este algoritmo se puede resumir en la siguiente fórmula:

   mcd(a,b) = a,                   si b = 0
            = b,                   si a = 0               
            = mcd (a módulo b, b), si a > b
            = mcd (a, b módulo a), si b >= a

mcd(a,b) = a, si b = 0

= b, si a = 0

= mcd (a módulo b, b), si a > b

= mcd (a, b módulo a), si b >= a

Definir la función

   mcdYdivisiones :: Int -> Int -> (Int,Int)

1	mcdYdivisiones :: Int -> Int -> (Int,Int)

tal que (mcdYdivisiones a b) es el número de divisiones usadas en el cálculo del máximo común divisor de a y b mediante el algoritmo de Euclides. Por ejemplo,

   mcdYdivisiones 252 198 == (18,4)

1	mcdYdivisiones 252 198 == (18,4)

ya que los 4 divisiones del cálculo son

     mcd 252 198
   = mcd  54 198
   = mcd  54  36
   = mcd  18  36
   = mcd  18   0

mcd 252 198

= mcd 54 198

= mcd 54 36

= mcd 18 36

= mcd 18 0

Comprobar con QuickCheck que el número de divisiones requeridas por el algoritmo de Euclides para calcular el MCD de a y b es igual o menor que cinco veces el número de dígitos de menor de los números a y b.

Soluciones

import Test.QuickCheck
import Debug.Trace 

mcdYdivisiones :: Int -> Int -> (Int,Int)
mcdYdivisiones a b = mcd a b 0
    where mcd a 0 n = (a,n)
          mcd 0 b n = (b,n)
          mcd a b n | a > b     = mcd (a `mod` b) b (n+1)
                    | otherwise = mcd a (b `mod` a) (n+1) 

-- La propiedad es
prop_mcdYdivisiones :: Int -> Int -> Property
prop_mcdYdivisiones a b =
    a > 0 && b > 0 ==>
      n < 5 * length (show (min a b))  
    where (_,n) = mcdYdivisiones a b
                 
-- La comprobación es
--    λ> quickCheck prop_mcdYdivisiones
--    +++ OK, passed 100 tests.

-- 2ª definición (con traza)
mcdYdivisiones2 :: Int -> Int -> (Int,Int)
mcdYdivisiones2 a b = mcd a b 0
    where mcd a b n
              | trace (show a ++ ", " ++ show b) False = undefined
          mcd a 0 n = (a,n)
          mcd 0 b n = (b,n)
          mcd a b n | a > b     = mcd (a `mod` b) b (n+1)
                    | otherwise = mcd a (b `mod` a) (n+1) 

-- Por ejemplo,
--    λ> mcdYdivisiones2 252 198
--    252, 198
--    54, 198
--    54, 36
--    18, 36
--    18, 0
--    (18,4)

import Test.QuickCheck

import Debug.Trace

mcdYdivisiones :: Int -> Int -> (Int,Int)

mcdYdivisiones a b = mcd a b 0

where mcd a 0 n = (a,n)

mcd 0 b n = (b,n)

mcd a b n | a > b = mcd (a `mod` b) b (n+1)

| otherwise = mcd a (b `mod` a) (n+1)

-- La propiedad es

prop_mcdYdivisiones :: Int -> Int -> Property

prop_mcdYdivisiones a b =

a > 0 && b > 0 ==>

n < 5 * length (show (min a b))

where (_,n) = mcdYdivisiones a b

-- La comprobación es

-- λ> quickCheck prop_mcdYdivisiones

-- +++ OK, passed 100 tests.

-- 2ª definición (con traza)

mcdYdivisiones2 :: Int -> Int -> (Int,Int)

mcdYdivisiones2 a b = mcd a b 0

where mcd a b n

| trace (show a ++ ", " ++ show b) False = undefined

mcd a 0 n = (a,n)

mcd 0 b n = (b,n)

mcd a b n | a > b = mcd (a `mod` b) b (n+1)

| otherwise = mcd a (b `mod` a) (n+1)

-- Por ejemplo,

-- λ> mcdYdivisiones2 252 198

-- 252, 198

-- 54, 198

-- 54, 36

-- 18, 36

-- 18, 0

-- (18,4)

Expresiones aritmética normalizadas

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

El siguiente tipo de dato representa expresiones construidas con variables, sumas y productos

   data Expr = Var String
             | S Expr Expr
             | P Expr Expre

data Expr = Var String

| S Expr Expr

| P Expr Expre

Por ejemplo, x.(y+z) se representa por (P (V «x») (S (V «y») (V «z»)))

Una expresión es un término si es un producto de variables. Por ejemplo, x.(y.z) es un término pero x+(y.z) ni x.(y+z) lo son.

Una expresión está en forma normal si es una suma de términos. Por ejemplo, x.(y,z) y x+(y.z) está en forma normal; pero x.(y+z) y (x+y).(x+z) no lo están.

Definir las funciones

   esTermino, esNormal :: Expr -> Bool

1	esTermino, esNormal :: Expr -> Bool

tales que

(esTermino a) se verifica si a es un término. Por ejemplo,

     esTermino (V "x")                                    == True
     esTermino (P (V "x") (P (V "y") (V "z")))            == True
     esTermino (P (V "x") (S (V "y") (V "z")))            == False
     esTermino (S (V "x") (P (V "y") (V "z")))            == False

esTermino (V "x") == True

esTermino (P (V "x") (P (V "y") (V "z"))) == True

esTermino (P (V "x") (S (V "y") (V "z"))) == False

esTermino (S (V "x") (P (V "y") (V "z"))) == False

(esNormal a) se verifica si a está en forma normal. Por ejemplo,

     esNormal (V "x")                                     == True
     esNormal (P (V "x") (P (V "y") (V "z")))             == True
     esNormal (S (V "x") (P (V "y") (V "z")))             == True
     esNormal (P (V "x") (S (V "y") (V "z")))             == False
     esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

esNormal (V "x") == True

esNormal (P (V "x") (P (V "y") (V "z"))) == True

esNormal (S (V "x") (P (V "y") (V "z"))) == True

esNormal (P (V "x") (S (V "y") (V "z"))) == False

esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

Soluciones

data Expr = V String
          | S Expr Expr
          | P Expr Expr

esTermino :: Expr -> Bool
esTermino (V _)   = True
esTermino (S _ _) = False
esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool
esNormal (S a b) = esNormal a && esNormal b
esNormal a       = esTermino a

data Expr = V String

| S Expr Expr

| P Expr Expr

esTermino :: Expr -> Bool

esTermino (V _) = True

esTermino (S _ _) = False

esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool

esNormal (S a b) = esNormal a && esNormal b

esNormal a = esTermino a

Mínimo número de cambios para igualar una lista

PorJosé A. Alonso 27-abril-20164-mayo-2016

Definir la función

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

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

tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,

   nMinimoCambios [3,5,3,7,9,6]      ==  4
   nMinimoCambios [3,5,3,7,3,3]      ==  2
   nMinimoCambios "Salamanca"        ==  5
   nMinimoCambios (4 : [1..500000])  ==  499999

nMinimoCambios [3,5,3,7,9,6] == 4

nMinimoCambios [3,5,3,7,3,3] == 2

nMinimoCambios "Salamanca" == 5

nMinimoCambios (4 : [1..500000]) == 499999

En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.

Soluciones

import Data.List (group, nub, sort)

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

nMinimoCambios1 :: Ord a => [a] -> Int
nMinimoCambios1 xs = 
    length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias :: Ord a => [a] -> [(Int,a)]
frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,
--    cuenta 3 [3,5,3,7,9,6]  ==  2
cuenta :: Ord a => a -> [a] -> Int
cuenta x ys = length [y | y <- ys, y == x]

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

nMinimoCambios2 :: Ord a => [a] -> Int
nMinimoCambios2 xs = 
    length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias2 [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias2 [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias2 :: Ord a  => [a] -> [(Int,a)]
frecuencias2 xs = 
    [(1 + length ys, y) | (y:ys) <- group (sort xs)] 

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

nMinimoCambios3 :: Ord a => [a] -> Int
nMinimoCambios3 xs = sum ys - maximum ys
    where ys = [length ys | ys <- group (sort xs)]

import Data.List (group, nub, sort)

-- 1ª definición

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

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

nMinimoCambios1 xs =

length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

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

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

frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,

-- cuenta 3 [3,5,3,7,9,6] == 2

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

cuenta x ys = length [y | y <- ys, y == x]

-- 2ª definición

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

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

nMinimoCambios2 xs =

length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias2 [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

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

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

frecuencias2 xs =

[(1 + length ys, y) | (y:ys) <- group (sort xs)]

-- 3ª definición

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

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

nMinimoCambios3 xs = sum ys - maximum ys

where ys = [length ys | ys <- group (sort xs)]

Productos simultáneos de dos y tres números consecutivos

PorJosé A. Alonso 25-abril-201625-abril-2021

Definir la función

   productos :: Integer -> Integer -> [[Integer]]

1	productos :: Integer -> Integer -> [[Integer]]

tal que (productos n x) es las listas de n elementos consecutivos cuyo producto es x. Por ejemplo,

   productos 2 6     ==  [[2,3]]
   productos 3 6     ==  [[1,2,3]]
   productos 4 1680  ==  [[5,6,7,8]]
   productos 2 5     ==  []

productos 2 6 == [[2,3]]

productos 3 6 == [[1,2,3]]

productos 4 1680 == [[5,6,7,8]]

productos 2 5 == []

Comprobar con QuickCheck que si n > 0 y x > 0, entonces

   productos n (product [x..x+n-1]) == [[x..x+n-1]]

1	productos n (product [x..x+n-1]) == [[x..x+n-1]]

Usando productos, definir la función

   productosDe2y3consecutivos :: [Integer]

1	productosDe2y3consecutivos :: [Integer]

cuyos elementos son los números naturales (no nulos) que pueden expresarse simultáneamente como producto de dos y tres números consecutivos. Por ejemplo,

   head productosDe2y3consecutivos  ==  6

1	head productosDe2y3consecutivos == 6

Nota. Según demostró Mordell en 1962, productosDe2y3consecutivos sólo tiene dos elementos.

Soluciones

import Test.QuickCheck

-- 1ª definición
productos1 :: Integer -> Integer -> [[Integer]]
productos1 n x = [[y..y+n-1] | y <- [1..x],
                               product [y..y+n-1] == x]

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

-- Se puede reducir el intervalo de búsqueda teniendo en cuenta las
-- siguientes desigualdades
--    y*(y+1)* ... (y+n-1) = x
--    y^n <= x <= (y+n-1)^n
--    y <= x^(1/n), x^(1/n)-n+1 <= y
--    x^(1/n)-n+1 <= y <= x^(1/n)

productos2 :: Integer -> Integer -> [[Integer]]
productos2 n x = [[z..z+n-1] | z <- [y-n+1..y],
                               product [z..z+n-1] == x]
    where y = floor ((fromIntegral x)**(1/(fromIntegral n)))

productos :: Integer -> Integer -> [[Integer]]
productos = productos2

prop_productos n x =
    n > 0 && x > 0 ==> productos n (product [x..x+n-1]) == [[x..x+n-1]]

-- La comprobación es
--    ghci> quickCheck prop_productos
--    +++ OK, passed 100 tests.
--    (0.10 secs, 26409644 bytes)

productosDe2y3consecutivos :: [Integer]
productosDe2y3consecutivos = [x| x <- [1..], 
                                 let ys = productos 2 x,
                                 not (null ys), 
                                 let zs = productos 3 x,
                                 not (null zs)] 

-- El cálculo es
--    ghci> take 2 productosDe2y3consecutivos
--    [6,210]
--    ghci> productos 2 210
--    [[14,15]]
--    ghci> productos 3 210
--    [[5,6,7]]

import Test.QuickCheck

-- 1ª definición

productos1 :: Integer -> Integer -> [[Integer]]

productos1 n x = [[y..y+n-1] | y <- [1..x],

product [y..y+n-1] == x]

-- 2ª definición

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

-- Se puede reducir el intervalo de búsqueda teniendo en cuenta las

-- siguientes desigualdades

-- y*(y+1)* ... (y+n-1) = x

-- y^n <= x <= (y+n-1)^n

-- y <= x^(1/n), x^(1/n)-n+1 <= y

-- x^(1/n)-n+1 <= y <= x^(1/n)

productos2 :: Integer -> Integer -> [[Integer]]

productos2 n x = [[z..z+n-1] | z <- [y-n+1..y],

product [z..z+n-1] == x]

where y = floor ((fromIntegral x)**(1/(fromIntegral n)))

productos :: Integer -> Integer -> [[Integer]]

productos = productos2

prop_productos n x =

n > 0 && x > 0 ==> productos n (product [x..x+n-1]) == [[x..x+n-1]]

-- La comprobación es

-- ghci> quickCheck prop_productos

-- +++ OK, passed 100 tests.

-- (0.10 secs, 26409644 bytes)

productosDe2y3consecutivos :: [Integer]

productosDe2y3consecutivos = [x| x <- [1..],

let ys = productos 2 x,

not (null ys),

let zs = productos 3 x,

not (null zs)]

-- El cálculo es

-- ghci> take 2 productosDe2y3consecutivos

-- [6,210]

-- ghci> productos 2 210

-- [[14,15]]

-- ghci> productos 3 210

-- [[5,6,7]]

Mínima diferencia entre elementos de una lista

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

Definir la función

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

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

tal que (minimaDiferencia xs) es el menor valor absoluto de las diferencias entre todos los pares de elementos de xs (que se supone que tiene al menos 2 elementos). Por ejemplo,

   minimaDiferencia [1,5,3,19,18,25]  ==  1
   minimaDiferencia [30,5,20,9]       ==  4
   minimaDiferencia [30,5,20,9,5]     ==  0
   minimaDiferencia [1..10^6]         ==  1

minimaDiferencia [1,5,3,19,18,25] == 1

minimaDiferencia [30,5,20,9] == 4

minimaDiferencia [30,5,20,9,5] == 0

minimaDiferencia [1..10^6] == 1

En el primer ejemplo la menor diferencia es 1 y se da entre los elementos 19 y 18; en el 2ª es 4 entre los elementos 5 y 9 y en la 3ª es 0 porque el elemento 5 está repetido.

Soluciones

import Data.List (delete, sort)

-- 1ª definición    
minimaDiferencia1 :: (Num a, Ord a) => [a] -> a
minimaDiferencia1 xs =
    minimum [abs (x - y) | x <- xs, y <- delete x xs]

-- 2ª definición    
minimaDiferencia2 :: (Num a, Ord a) => [a] -> a
minimaDiferencia2 [x,y]  = abs (x - y)
minimaDiferencia2 (x:xs) = min (minimum [abs (x - y) | y <- xs])
                               (minimaDiferencia2 xs)      

-- 3ª definición    
minimaDiferencia3 :: (Num a, Ord a) => [a] -> a
minimaDiferencia3 xs =
    minimum [y - x | (x,y) <- zip ys (tail ys)]
    where ys = sort xs

-- Comparación de eficiencia
--    λ> minimaDiferencia1 [1..2*10^3]
--    1
--    (3.47 secs, 1,419,790,688 bytes)
--    λ> minimaDiferencia2 [1..2*10^3]
--    1
--    (0.78 secs, 684,030,712 bytes)
--    λ> minimaDiferencia3 [1..2*10^3]
--    1
--    (0.02 secs, 0 bytes)
--    
--    λ> minimaDiferencia2 [1..5*10^3]
--    1
--    (5.14 secs, 4,233,952,776 bytes)
--    λ> minimaDiferencia3 [1..5*10^3]
--    1
--    (0.02 secs, 0 bytes)

import Data.List (delete, sort)

-- 1ª definición

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

minimaDiferencia1 xs =

minimum [abs (x - y) | x <- xs, y <- delete x xs]

-- 2ª definición

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

minimaDiferencia2 [x,y] = abs (x - y)

minimaDiferencia2 (x:xs) = min (minimum [abs (x - y) | y <- xs])

(minimaDiferencia2 xs)

-- 3ª definición

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

minimaDiferencia3 xs =

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

where ys = sort xs

-- Comparación de eficiencia

-- λ> minimaDiferencia1 [1..2*10^3]

-- 1

-- (3.47 secs, 1,419,790,688 bytes)

-- λ> minimaDiferencia2 [1..2*10^3]

-- 1

-- (0.78 secs, 684,030,712 bytes)

-- λ> minimaDiferencia3 [1..2*10^3]

-- 1

-- (0.02 secs, 0 bytes)

-- λ> minimaDiferencia2 [1..5*10^3]

-- 1

-- (5.14 secs, 4,233,952,776 bytes)

-- λ> minimaDiferencia3 [1..5*10^3]

-- 1

-- (0.02 secs, 0 bytes)

Raíz entera

PorJosé A. Alonso 8-abril-20161-mayo-2016

Definir la función

   raizEnt :: Integer -> Integer -> Integer

1	raizEnt :: Integer -> Integer -> Integer

tal que (raizEnt x n) es la raíz entera n-ésima de x; es decir, el mayor número entero y tal que y^n <= x. Por ejemplo,

   raizEnt  8 3      ==  2
   raizEnt  9 3      ==  2
   raizEnt 26 3      ==  2
   raizEnt 27 3      ==  3
   raizEnt (10^50) 2 ==  10000000000000000000000000

raizEnt 8 3 == 2

raizEnt 9 3 == 2

raizEnt 26 3 == 2

raizEnt 27 3 == 3

raizEnt (10^50) 2 == 10000000000000000000000000

Comprobar con QuickCheck que para todo número natural n,

    raizEnt (10^(2*n)) 2 == 10^n

1	raizEnt (10^(2*n)) 2 == 10^n

Soluciones

import Test.QuickCheck

-- 1ª definición
raizEnt1 :: Integer -> Integer -> Integer
raizEnt1 x n =
    last (takeWhile (\y -> y^n <= x) [0..])

-- 2ª definición         
raizEnt2 :: Integer -> Integer -> Integer
raizEnt2 x n =
    floor ((fromIntegral x)**(1 / fromIntegral n))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,
--    λ> raizEnt2 (10^50) 2 == 10^25
--    False
          
-- 3ª definición          
raizEnt3 :: Integer -> Integer -> Integer
raizEnt3 x n = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^n

-- Comparación de eficiencia
--    λ> raizEnt1 (10^14) 2
--    10000000
--    (6.15 secs, 6,539,367,976 bytes)
--    λ> raizEnt2 (10^14) 2
--    10000000
--    (0.00 secs, 0 bytes)
--    λ> raizEnt3 (10^14) 2
--    10000000
--    (0.00 secs, 25,871,944 bytes)
--    
--    λ> raizEnt2 (10^50) 2
--    9999999999999998758486016
--    (0.00 secs, 0 bytes)
--    λ> raizEnt3 (10^50) 2
--    10000000000000000000000000
--    (0.00 secs, 0 bytes)
                        
-- La propiedad es                        
prop_raizEnt :: Integer -> Bool
prop_raizEnt n =
    raizEnt3 (10^(2*m)) 2 == 10^m
    where m = abs n

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

import Test.QuickCheck

-- 1ª definición

raizEnt1 :: Integer -> Integer -> Integer

raizEnt1 x n =

last (takeWhile (\y -> y^n <= x) [0..])

-- 2ª definición

raizEnt2 :: Integer -> Integer -> Integer

raizEnt2 x n =

floor ((fromIntegral x)**(1 / fromIntegral n))

-- Nota. La definición anterior falla para números grandes. Por ejemplo,

-- λ> raizEnt2 (10^50) 2 == 10^25

-- False

-- 3ª definición

raizEnt3 :: Integer -> Integer -> Integer

raizEnt3 x n = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^n

-- Comparación de eficiencia

-- λ> raizEnt1 (10^14) 2

-- 10000000

-- (6.15 secs, 6,539,367,976 bytes)

-- λ> raizEnt2 (10^14) 2

-- 10000000

-- (0.00 secs, 0 bytes)

-- λ> raizEnt3 (10^14) 2

-- 10000000

-- (0.00 secs, 25,871,944 bytes)

-- λ> raizEnt2 (10^50) 2

-- 9999999999999998758486016

-- (0.00 secs, 0 bytes)

-- λ> raizEnt3 (10^50) 2

-- 10000000000000000000000000

-- (0.00 secs, 0 bytes)

-- La propiedad es

prop_raizEnt :: Integer -> Bool

prop_raizEnt n =

raizEnt3 (10^(2*m)) 2 == 10^m

where m = abs n

-- La comprobación es

-- λ> quickCheck prop_raizEnt

-- +++ OK, passed 100 tests.

Soluciones en Maxima

raizEnt (x,n) := inrt (x,n)$

1	raizEnt (x,n) := inrt (x,n)$

Inverso multiplicativo modular

PorJosé A. Alonso 6-abril-201626-marzo-2022

El inverso multiplicativo modular de un entero n módulo p es el número m, entre 1 y p-1, tal que

   mn = 1 (mod p)

1	mn = 1 (mod p)

Por ejemplo, el inverso multiplicativo de 2 módulo 5 es 3, ya que 1 <= 3 <= 4 y 2×3 = 1 (mod 5).

El inverso multipicativo de n módulo p existe si y sólo si n y p son coprimos; es decir, si mcd(n,p) = 1.

Definir la función

   invMod :: Integer -> Integer -> Maybe Integer

1	invMod :: Integer -> Integer -> Maybe Integer

tal que (invMod n p) es justo el inverso multiplicativo de n módulo p, si existe y Nothing en caso contrario. Por ejemplo,

   λ> invMod 2 5
   Just 3
   λ> invMod 2 6
   Nothing
   λ> [(x,invMod x 5) | x <- [0..4]]
   [(0,Nothing),(1,Just 1),(2,Just 3),(3,Just 2),(4,Just 4)]
   λ> [(x,invMod x 6) | x <- [0..5]]
   [(0,Nothing),(1,Just 1),(2,Nothing),(3,Nothing),(4,Nothing),(5,Just 5)]
   λ> let n = 10^7 in invMod (10^n) (1+10^n) == Just (10^n)
   True

λ> invMod 2 5

Just 3

λ> invMod 2 6

Nothing

λ> [(x,invMod x 5) | x <- [0..4]]

[(0,Nothing),(1,Just 1),(2,Just 3),(3,Just 2),(4,Just 4)]

λ> [(x,invMod x 6) | x <- [0..5]]

[(0,Nothing),(1,Just 1),(2,Nothing),(3,Nothing),(4,Nothing),(5,Just 5)]

λ> let n = 10^7 in invMod (10^n) (1+10^n) == Just (10^n)

True

Soluciones

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

invMod1 :: Integer -> Integer -> Maybe Integer
invMod1 n p | gcd n p == 1 = Just (head [m | m <- [1..p-1], m*n `mod` p == 1])
            | otherwise    = Nothing

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

invMod2 :: Integer -> Integer -> Maybe Integer
invMod2 n p | m /= 1    = Nothing
            | x < 0     = Just (x + p)
            | otherwise = Just x
    where (x,_,m) = mcdExt n p

-- [Algoritmo extendido de Euclides]
-- (mcd a b) es la terna (x,y,g) tal que g es el máximo común divisor
-- de a y b y se cumple que ax + by = g. Por ejemplo,
--    mcdExt  2  5  ==  (-2,1,1)
--    mcdExt  2  6  ==  ( 1,0,2)
--    mcdExt 12 15  ==  (-1,1,3)
mcdExt :: Integer -> Integer -> (Integer,Integer,Integer)
mcdExt a 0 = (1, 0, a)
mcdExt a b = (t, s - q * t, g)
  where (q, r)    = a `quotRem` b
        (s, t, g) = mcdExt b r

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

invMod3 :: Integer -> Integer -> Maybe Integer
invMod3 n p | gcd n p == 1 = Just (aux n p)
            | otherwise    = Nothing
  where aux 1 p = 1
        aux n p = (x * p + 1) `div` n
          where x = n - aux (p `mod` n) n                    

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

--    λ> invMod1 (10^7) (1+10^7)
--    Just 10000000
--    (5.05 secs, 2,872,350,896 bytes)
--    λ> invMod2 (10^7) (1+10^7)
--    Just 10000000
--    (0.00 secs, 0 bytes)
--    λ> invMod3 (10^7) (1+10^7)
--    Just 10000000
--    (0.00 secs, 0 bytes)
--    
--    λ> let n = 10^7 in invMod2 (10^n) (1+10^n) == Just (10^n)
--    True
--    (0.88 secs, 55,728,120 bytes)
--    λ> let n = 10^7 in invMod3 (10^n) (1+10^n) == Just (10^n)
--    True
--    (1.99 secs, 80,644,352 bytes)

-- 1ª definición

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

invMod1 :: Integer -> Integer -> Maybe Integer

invMod1 n p | gcd n p == 1 = Just (head [m | m <- [1..p-1], m*n `mod` p == 1])

| otherwise = Nothing

-- 2ª definición

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

invMod2 :: Integer -> Integer -> Maybe Integer

invMod2 n p | m /= 1 = Nothing

| x < 0 = Just (x + p)

| otherwise = Just x

where (x,_,m) = mcdExt n p

-- [Algoritmo extendido de Euclides]

-- (mcd a b) es la terna (x,y,g) tal que g es el máximo común divisor

-- de a y b y se cumple que ax + by = g. Por ejemplo,

-- mcdExt 2 5 == (-2,1,1)

-- mcdExt 2 6 == ( 1,0,2)

-- mcdExt 12 15 == (-1,1,3)

mcdExt :: Integer -> Integer -> (Integer,Integer,Integer)

mcdExt a 0 = (1, 0, a)

mcdExt a b = (t, s - q * t, g)

where (q, r) = a `quotRem` b

(s, t, g) = mcdExt b r

-- 3ª definición

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

invMod3 :: Integer -> Integer -> Maybe Integer

invMod3 n p | gcd n p == 1 = Just (aux n p)

| otherwise = Nothing

where aux 1 p = 1

aux n p = (x * p + 1) `div` n

where x = n - aux (p `mod` n) n

-- Comparación de eficiencia

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

-- λ> invMod1 (10^7) (1+10^7)

-- Just 10000000

-- (5.05 secs, 2,872,350,896 bytes)

-- λ> invMod2 (10^7) (1+10^7)

-- Just 10000000

-- (0.00 secs, 0 bytes)

-- λ> invMod3 (10^7) (1+10^7)

-- Just 10000000

-- (0.00 secs, 0 bytes)

-- λ> let n = 10^7 in invMod2 (10^n) (1+10^n) == Just (10^n)

-- True

-- (0.88 secs, 55,728,120 bytes)

-- λ> let n = 10^7 in invMod3 (10^n) (1+10^n) == Just (10^n)

-- True

-- (1.99 secs, 80,644,352 bytes)

Solución en Maxima

invMod (n,p) := block ([r],
  r : inv_mod (n,p),
  if integerp (r)
  then Just (r)
  else Nothing)$

invMod (n,p) := block ([r],

r : inv_mod (n,p),

if integerp (r)

then Just (r)

else Nothing)$

La evaluación de los ejemplos es

(%i2) invMod (2,5);
(%o2) Just(3)
(%i3) invMod (2,6);
(%o3) Nothing
(%i4) makelist([x,invMod(x,5)],x,0,4);
(%o4) [[0,Nothing],[1,Just(1)],[2,Just(3)],[3,Just(2)],[4,Just(4)]]
(%i5) makelist([x,invMod(x,6)],x,0,5);
(%o5) [[0,Nothing],[1,Just(1)],[2,Nothing],[3,Nothing],[4,Nothing],[5,Just(5)]]
(%i6) (n : 10^7, is (invMod (10^n,1+10^n) = Just (10^n)));
(%o6) true

(%i2) invMod (2,5);

(%o2) Just(3)

(%i3) invMod (2,6);

(%o3) Nothing

(%i4) makelist([x,invMod(x,5)],x,0,4);

(%o4) [[0,Nothing],[1,Just(1)],[2,Just(3)],[3,Just(2)],[4,Just(4)]]

(%i5) makelist([x,invMod(x,6)],x,0,5);

(%o5) [[0,Nothing],[1,Just(1)],[2,Nothing],[3,Nothing],[4,Nothing],[5,Just(5)]]

(%i6) (n : 10^7, is (invMod (10^n,1+10^n) = Just (10^n)));

(%o6) true

Referencia

Calculating multiplicative inverses in modular arithmetic

Números cuyos dígitos coinciden con los de sus factores primos

PorJosé A. Alonso 30-marzo-201625-marzo-2022

Un número n es especial si al unir los dígitos de sus factores primos, se obtienen exactamente los dígitos de n, aunque puede ser en otro orden. Por ejemplo, 1255 es especial, pues los factores primos de 1255 son 5 y 251.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

tal que (esEspecial n) se verifica si un número n es especial. Por ejemplo,

   esEspecial 1255 == True
   esEspecial 125  == False
   esEspecial 132  == False

esEspecial 1255 == True

esEspecial 125 == False

esEspecial 132 == False

Comprobar con QuickCheck que todo número primo es especial.

Calcular los 5 primeros números especiales que no son primos.

Soluciones

import Data.List (nub, sort)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

esEspecial :: Integer -> Bool
esEspecial n = 
    sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es
prop_primos:: Integer -> Property
prop_primos n = 
    isPrime (abs n) ==> esEspecial (abs n)

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

-- El cálculo es
--    ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]
--    [735,1255,3792,7236,11913]

import Data.List (nub, sort)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

esEspecial :: Integer -> Bool

esEspecial n =

sort (show n) == sort (concatMap show (nub (primeFactors n)))

-- La propiedad es

prop_primos:: Integer -> Property

prop_primos n =

isPrime (abs n) ==> esEspecial (abs n)

-- La comprobación es

-- ghci> quickCheck prop_primos

-- +++ OK, passed 100 tests.

-- El cálculo es

-- ghci> take 5 [n | n <- [2..], esEspecial n, not (isPrime n)]

-- [735,1255,3792,7236,11913]

Evaluación de expresiones aritméticas

PorJosé A. Alonso 29-marzo-201626-marzo-2022

Las expresiones aritméticas se pueden definir mediante el siguiente tipo de dato

   data Expr  = N Int | V Char | Sum Expr Expr | Mul Expr Expr 
                deriving Show

1 2	data Expr = N Int \| V Char \| Sum Expr Expr \| Mul Expr Expr deriving Show

Por ejemplo, (x+3)+(7*y) se representa por

   ejExpr :: Expr
   ejExpr = Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))

1 2	ejExpr :: Expr ejExpr = Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))

Definir la función

   valor :: Expr -> Maybe Int

1	valor :: Expr -> Maybe Int

tal que (valor e) es ‘Just v’ si la expresión e es numérica y v es su valor, o bien ‘Nothing’ si e no es numérica. Por ejemplo:

   valor (Sum (N 7) (N 9))                            == Just 16
   valor (Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))) == Nothing
   valor (Sum (Sum (N 1) (N 3))(Mul (N 7) (N 2)))     == Just 18

valor (Sum (N 7) (N 9)) == Just 16

valor (Sum (Sum (V 'x') (N 3))(Mul (N 7) (V 'y'))) == Nothing

valor (Sum (Sum (N 1) (N 3))(Mul (N 7) (N 2))) == Just 18

Soluciones

data Expr  = N Int | V Char | Sum Expr Expr | Mul Expr Expr 
             deriving Show

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

valor1 :: Expr -> Maybe Int
valor1 e | null (aux e) = Nothing
         | otherwise    = Just (head (aux e))
    where aux (N x)       = [x]
          aux (V _)       = []
          aux (Sum e1 e2) = [x+y| x <- aux e1, y <- aux e2]
          aux (Mul e1 e2) = [x*y| x <- aux e1, y <- aux e2]

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

valor2 :: Expr -> Maybe Int
valor2 e | numerico e = Just (aux e)
         | otherwise  = Nothing
    where aux (N x)       = x
          aux (Sum e1 e2) = aux e1 + aux e2
          aux (Mul e1 e2) = aux e1 * aux e2

numerico :: Expr -> Bool
numerico (N _)       = True
numerico (V _)       = False
numerico (Sum e1 e2) = numerico e1 && numerico e2
numerico (Mul e1 e2) = numerico e1 && numerico e2

data Expr = N Int | V Char | Sum Expr Expr | Mul Expr Expr

deriving Show

-- 1ª solución

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

valor1 :: Expr -> Maybe Int

valor1 e | null (aux e) = Nothing

| otherwise = Just (head (aux e))

where aux (N x) = [x]

aux (V _) = []

aux (Sum e1 e2) = [x+y| x <- aux e1, y <- aux e2]

aux (Mul e1 e2) = [x*y| x <- aux e1, y <- aux e2]

-- 2ª solución

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

valor2 :: Expr -> Maybe Int

valor2 e | numerico e = Just (aux e)

| otherwise = Nothing

where aux (N x) = x

aux (Sum e1 e2) = aux e1 + aux e2

aux (Mul e1 e2) = aux e1 * aux e2

numerico :: Expr -> Bool

numerico (N _) = True

numerico (V _) = False

numerico (Sum e1 e2) = numerico e1 && numerico e2

numerico (Mul e1 e2) = numerico e1 && numerico e2

Posiciones de máximos locales

PorJosé A. Alonso 28-marzo-20164-abril-2016

Los vectores se definen usando tablas como sigue:

   type Vector a = Array Int a

1	type Vector a = Array Int a

Un elemento de un vector es un máximo local si no tiene ningún elemento adyacente mayor o igual que él.

Definir la función

   posMaxVec :: Ord a => Vector a -> [Int]

1	posMaxVec :: Ord a => Vector a -> [Int]

tal que (posMaxVec p) devuelve las posiciones del vector p en las que p tiene un máximo local. Por ejemplo,

   posMaxVec (listArray (1,6) [3,2,6,7,5,3]) == [1,4]
   posMaxVec (listArray (1,2) [5,5])         == []
   posMaxVec (listArray (1,1) [5])           == [1]

posMaxVec (listArray (1,6) [3,2,6,7,5,3]) == [1,4]

posMaxVec (listArray (1,2) [5,5]) == []

posMaxVec (listArray (1,1) [5]) == [1]

Soluciones

import Data.Array

type Vector a = Array Int a

-- 1ª definición
posMaxVec :: Ord a => Vector a -> [Int]
posMaxVec p 
    | n == 1 = [1]
    | otherwise = 
        (if p!1 > p!2 then [1] else []) ++ 
        [i | i <- [2..n-1], p!(i-1) < p!i && p!(i+1) < p!i] ++
        (if p!(n-1) < p!n then [n] else [])
    where (_,n) = bounds p

-- 2ª definición
posMaxVec2 :: Ord a => Vector a -> [Int]
posMaxVec2 p  
    | n == 1 = [1]
    | otherwise = 
        [1 | p ! 1 > p ! 2] ++ 
        [i | i <- [2..n-1], p!(i-1) < p!i && p!(i+1) < p!i] ++
        [n | p ! (n - 1) < p ! n]
    where (_,n) = bounds p

-- 3ª definición
posMaxVec3 :: Ord a => Vector a -> [Int]
posMaxVec3 p  
    | n == 1    = [1]
    | otherwise = [i | i <- [1..n],
                       all (<p!i) [p!j | j <- vecinos i]]
    where (_,n) = bounds p
          vecinos 1 = [2]
          vecinos j | j == n    = [n-1]
                    | otherwise = [j-1,j+1]

-- 4ª definición
posMaxVec4 :: Ord a => Vector a -> [Int]
posMaxVec4 p = [i | (i,x) <- assocs p
                  , i == a || p!(i-1) < x
                  , i == b || p!(i+1) < x ]
    where (a,b) = bounds p

import Data.Array

type Vector a = Array Int a

-- 1ª definición

posMaxVec :: Ord a => Vector a -> [Int]

posMaxVec p

| n == 1 = [1]

| otherwise =

(if p!1 > p!2 then [1] else []) ++

[i | i <- [2..n-1], p!(i-1) < p!i && p!(i+1) < p!i] ++

(if p!(n-1) < p!n then [n] else [])

where (_,n) = bounds p

-- 2ª definición

posMaxVec2 :: Ord a => Vector a -> [Int]

posMaxVec2 p

| n == 1 = [1]

| otherwise =

[1 | p ! 1 > p ! 2] ++

[i | i <- [2..n-1], p!(i-1) < p!i && p!(i+1) < p!i] ++

[n | p ! (n - 1) < p ! n]

where (_,n) = bounds p

-- 3ª definición

posMaxVec3 :: Ord a => Vector a -> [Int]

posMaxVec3 p

| n == 1 = [1]

| otherwise = [i | i <- [1..n],

all (<p!i) [p!j | j <- vecinos i]]

where (_,n) = bounds p

vecinos 1 = [2]

vecinos j | j == n = [n-1]

| otherwise = [j-1,j+1]

-- 4ª definición

posMaxVec4 :: Ord a => Vector a -> [Int]

posMaxVec4 p = [i | (i,x) <- assocs p

, i == a || p!(i-1) < x

, i == b || p!(i+1) < x ]

where (a,b) = bounds p

Máxima suma de elementos consecutivos

PorJosé A. Alonso 17-marzo-20161-mayo-2016

Definir la función

   sumaMaxima :: [Integer] -> Integer

1	sumaMaxima :: [Integer] -> Integer

tal que (sumaMaxima xs) es el valor máximo de la suma de elementos consecutivos de la lista xs. Por ejemplo,

   sumaMaxima []             ==  0 
   sumaMaxima [2,-2,3,-3,4]  ==  4
   sumaMaxima [-1,-2,-3]     ==  0
   sumaMaxima [2,-1,3,-2,3]  ==  5
   sumaMaxima [1,-1,3,-2,4]  ==  5
   sumaMaxima [2,-1,3,-2,4]  ==  6
   sumaMaxima [1..10^6]      ==  500000500000

sumaMaxima [] == 0

sumaMaxima [2,-2,3,-3,4] == 4

sumaMaxima [-1,-2,-3] == 0

sumaMaxima [2,-1,3,-2,3] == 5

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

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

sumaMaxima [1..10^6] == 500000500000

Comprobar con QuickCheck que

   sumaMaxima xs == sumaMaxima (reverse xs)

1	sumaMaxima xs == sumaMaxima (reverse xs)

Soluciones

import Data.List (inits, tails)
import Test.QuickCheck

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

sumaMaxima1 :: [Integer] -> Integer
sumaMaxima1 [] = 0
sumaMaxima1 xs =
    maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],
                                            j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]
sublista xs i j =
    [xs!!k | k <- [i..j]]

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

sumaMaxima2 :: [Integer] -> Integer
sumaMaxima2 [] = 0
sumaMaxima2 xs = sumaMaximaAux 0 0 xs
    where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer
sumaMaximaAux m v [] = max m v
sumaMaximaAux m v (x:xs)
    | x >= 0    = sumaMaximaAux m (v+x) xs
    | v+x > 0   = sumaMaximaAux (max m v) (v+x) xs
    | otherwise = sumaMaximaAux (max m v) 0 xs

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

sumaMaxima3 :: [Integer] -> Integer
sumaMaxima3 [] = 0
sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo 
--    segmentos "abc"  ==  ["", "a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
    [] : concat [tail (inits ys) | ys <- init (tails xs)]

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

sumaMaxima4 :: [Integer] -> Integer
sumaMaxima4 [] = 0
sumaMaxima4 xs = 
    maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación
-- ============

-- La propiedad es
prop_sumaMaxima :: [Integer] -> Bool
prop_sumaMaxima xs =
    sumaMaxima2 xs == n &&
    sumaMaxima3 xs == n &&
    sumaMaxima4 xs == n
    where n = sumaMaxima1 xs

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

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

--    λ> let n = 10^2 in sumaMaxima1 [-n..n] 
--    5050
--    (2.10 secs, 390,399,104 bytes)
--    λ> let n = 10^2 in sumaMaxima2 [-n..n] 
--    5050
--    (0.02 secs, 0 bytes)
--    λ> let n = 10^2 in sumaMaxima3 [-n..n] 
--    5050
--    (0.27 secs, 147,705,184 bytes)
--    λ> let n = 10^2 in sumaMaxima4 [-n..n] 
--    5050
--    (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool
prop_inversa xs =
    sumaMaxima2 xs == sumaMaxima2 (reverse xs)

import Data.List (inits, tails)

import Test.QuickCheck

-- 1ª definición

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

sumaMaxima1 :: [Integer] -> Integer

sumaMaxima1 [] = 0

sumaMaxima1 xs =

maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],

j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]

sublista xs i j =

[xs!!k | k <- [i..j]]

-- 2ª definición

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

sumaMaxima2 :: [Integer] -> Integer

sumaMaxima2 [] = 0

sumaMaxima2 xs = sumaMaximaAux 0 0 xs

where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer

sumaMaximaAux m v [] = max m v

sumaMaximaAux m v (x:xs)

| x >= 0 = sumaMaximaAux m (v+x) xs

| v+x > 0 = sumaMaximaAux (max m v) (v+x) xs

| otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición

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

sumaMaxima3 :: [Integer] -> Integer

sumaMaxima3 [] = 0

sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo

-- segmentos "abc" == ["", "a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición

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

sumaMaxima4 :: [Integer] -> Integer

sumaMaxima4 [] = 0

sumaMaxima4 xs =

maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación

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

-- La propiedad es

prop_sumaMaxima :: [Integer] -> Bool

prop_sumaMaxima xs =

sumaMaxima2 xs == n &&

sumaMaxima3 xs == n &&

sumaMaxima4 xs == n

where n = sumaMaxima1 xs

-- La comprobación es

-- λ> quickCheck prop_sumaMaxima

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> let n = 10^2 in sumaMaxima1 [-n..n]

-- 5050

-- (2.10 secs, 390,399,104 bytes)

-- λ> let n = 10^2 in sumaMaxima2 [-n..n]

-- 5050

-- (0.02 secs, 0 bytes)

-- λ> let n = 10^2 in sumaMaxima3 [-n..n]

-- 5050

-- (0.27 secs, 147,705,184 bytes)

-- λ> let n = 10^2 in sumaMaxima4 [-n..n]

-- 5050

-- (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool

prop_inversa xs =

sumaMaxima2 xs == sumaMaxima2 (reverse xs)

Rotación de una matriz

PorJosé A. Alonso 16-marzo-201630-marzo-2016

En la siguiente figura, al rotar girando 90 grados en el sentido del reloj la matriz de la izquierda, obtenemos la de la derecha

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

1 2 3 7 4 1

4 5 6 8 5 2

7 8 9 9 6 3

Definir la función

   rota :: Matrix Int -> Matrix Int

1	rota :: Matrix Int -> Matrix Int

tal que (rota p) es la matriz obtenida girando en el sentido del reloj la matriz cuadrada p. Por ejemplo,

   λ> rota (fromList 3 3 [1..9])
   ( 7 4 1 )
   ( 8 5 2 )
   ( 9 6 3 )
   
   λ> rota (fromList 3 3 [7,4,1,8,5,2,9,6,3])
   ( 9 8 7 )
   ( 6 5 4 )
   ( 3 2 1 )

λ> rota (fromList 3 3 [1..9])

( 7 4 1 )

( 8 5 2 )

( 9 6 3 )

λ> rota (fromList 3 3 [7,4,1,8,5,2,9,6,3])

( 9 8 7 )

( 6 5 4 )

( 3 2 1 )

Soluciones

import Data.Matrix

rota :: Matrix Int -> Matrix Int
rota p = matrix n m (\(i,j) -> p ! (n+1-j,i))
    where m = nrows p
          n = ncols p

import Data.Matrix

rota :: Matrix Int -> Matrix Int

rota p = matrix n m (\(i,j) -> p ! (n+1-j,i))

where m = nrows p

n = ncols p

Mayor sección inicial sin repetidos

PorJosé A. Alonso 15-marzo-20161-mayo-2016

Definir la función

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

1	seccion :: Eq a => [a] -> [a]

tal que (seccion xs) es el mayor sección inicial de xs que no contiene ningún elemento repetido. Por ejemplo:

   seccion [1,2,3,2,4,5]                      == [1,2,3] 
   seccion "caceres"                          == "ca"
   length (seccion ([1..7531] ++ [1..10^9]))  ==  7531

seccion [1,2,3,2,4,5] == [1,2,3]

seccion "caceres" == "ca"

length (seccion ([1..7531] ++ [1..10^9])) == 7531

Soluciones

import Data.List (inits, nub)

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

seccion1 :: Eq a => [a] -> [a]
seccion1 = last . filter (\ys -> nub ys == ys) . inits

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

seccion2 :: Eq a => [a] -> [a]
seccion2 xs = aux xs []
    where aux [] ys = reverse ys
          aux (x:xs) ys | x `elem` ys = reverse ys
                        | otherwise   = aux xs (x:ys)

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

--    ghci> last (seccion1 [1..10^3])
--    1000
--    (6.19 secs, 59,174,640 bytes)
--    ghci> last (seccion2 [1..10^3])
--    1000
--    (0.04 secs, 0 bytes)

import Data.List (inits, nub)

-- 1ª solución

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

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

seccion1 = last . filter (\ys -> nub ys == ys) . inits

-- 2ª solución

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

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

seccion2 xs = aux xs []

where aux [] ys = reverse ys

aux (x:xs) ys | x `elem` ys = reverse ys

| otherwise = aux xs (x:ys)

-- Comparación de eficiencia

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

-- ghci> last (seccion1 [1..10^3])

-- 1000

-- (6.19 secs, 59,174,640 bytes)

-- ghci> last (seccion2 [1..10^3])

-- 1000

-- (0.04 secs, 0 bytes)

Primo suma de dos cuadrados

PorJosé A. Alonso 14-marzo-20161-abril-2016

Definir la sucesión

   primosSumaDe2Cuadrados :: [Integer]

1	primosSumaDe2Cuadrados :: [Integer]

cuyos elementos son los números primos que se pueden escribir como sumas de dos cuadrados. Por ejemplo,

   λ> take 20 primosSumaDe2Cuadrados
   [2,5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181]
   λ> primosSumaDe2Cuadrados !! (2*10^5)
   5803241

λ> take 20 primosSumaDe2Cuadrados

[2,5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181]

λ> primosSumaDe2Cuadrados !! (2*10^5)

5803241

En el ejemplo anterior,

13 está en la sucesión porque es primo y 13 = 2²+3².
11 no está en la sucesión porque no se puede escribir como suma de dos cuadrados (en efecto, 11-1=10, 11-2²=7 y 11-3²=2 no son cuadrados).
20 no está en la sucesión porque, aunque es suma de dos cuadrados (20=4²+2²), no es primo.

Soluciones

import Data.Numbers.Primes (primes)

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

primosSumaDe2Cuadrados1 :: [Integer]
primosSumaDe2Cuadrados1 =
    [n | n <- primes,
         esSumaDe2Cuadrados n]

esSumaDe2Cuadrados :: Integer -> Bool
esSumaDe2Cuadrados n = not (null (sumas2cuadrados n))

sumas2cuadrados :: Integer -> [(Integer,Integer)]
sumas2cuadrados n = 
    [(x,y) | x <- [1..ceiling (sqrt (fromIntegral n))],
             let z = n - x^2,
             esCuadrado z, 
             let y = raiz z,
             x <= y]
             
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = x == y * y
    where y = raiz x

-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,
--    raiz 25  ==  5
--    raiz 24  ==  4
--    raiz 26  ==  5
raiz :: Integer -> Integer
raiz x = floor (sqrt (fromIntegral x))

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

primosSumaDe2Cuadrados2 :: [Integer]
primosSumaDe2Cuadrados2 =
    2 : [n | n <- primes,
             n `mod` 4 == 1]

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

--    λ> primosSumaDe2Cuadrados1 !! (2*10^3)
--    38153
--    (3.03 secs, 568,239,744 bytes)
--    λ> primosSumaDe2Cuadrados2 !! (2*10^3)
--    38153
--    (0.05 secs, 20,017,912 bytes)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosSumaDe2Cuadrados1 :: [Integer]

primosSumaDe2Cuadrados1 =

[n | n <- primes,

esSumaDe2Cuadrados n]

esSumaDe2Cuadrados :: Integer -> Bool

esSumaDe2Cuadrados n = not (null (sumas2cuadrados n))

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

sumas2cuadrados n =

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

let z = n - x^2,

esCuadrado z,

let y = raiz z,

x <= y]

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

esCuadrado x = x == y * y

where y = raiz x

-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,

-- raiz 25 == 5

-- raiz 24 == 4

-- raiz 26 == 5

raiz :: Integer -> Integer

raiz x = floor (sqrt (fromIntegral x))

-- 2ª solución

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

primosSumaDe2Cuadrados2 :: [Integer]

primosSumaDe2Cuadrados2 =

2 : [n | n <- primes,

n `mod` 4 == 1]

-- Comparación de eficiencia

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

-- λ> primosSumaDe2Cuadrados1 !! (2*10^3)

-- 38153

-- (3.03 secs, 568,239,744 bytes)

-- λ> primosSumaDe2Cuadrados2 !! (2*10^3)

-- 38153

-- (0.05 secs, 20,017,912 bytes)

Referencias

N.J.A. Sloane, Sucesión A002313 de la OEIS.
M. Bates, Primes of the form x² + ny²–
G. Xiao, Two squares.

Paridad del número de divisores

PorJosé A. Alonso 10-marzo-201617-marzo-2016

Definir la función

   nDivisoresPar :: Integer -> Bool

1	nDivisoresPar :: Integer -> Bool

tal que (nDivisoresPar n) se verifica si n tiene un número par de divisores. Por ejemplo,

   nDivisoresPar 12                     ==  True
   nDivisoresPar 16                     ==  False
   nDivisoresPar (product [1..2*10^4])  ==  True

nDivisoresPar 12 == True

nDivisoresPar 16 == False

nDivisoresPar (product [1..2*10^4]) == True

Soluciones

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

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

nDivisoresPar1 :: Integer -> Bool
nDivisoresPar1 = even . length . divisores

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

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

nDivisoresPar2 :: Integer -> Bool
nDivisoresPar2 n =
    any odd (map length (group (primeFactors n)))

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

--    λ> nDivisoresPar1 (10^7)
--    True
--    (14.18 secs, 2,078,736,992 bytes)
--    λ> nDivisoresPar2 (10^7)
--    True
--    (0.01 secs, 0 bytes)
--
--    λ> nDivisoresPar2 (product [1..2*10^4])
--    True
--    (2.30 secs, 1,003,013,112 bytes)

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

-- 1ª definición

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

nDivisoresPar1 :: Integer -> Bool

nDivisoresPar1 = even . length . divisores

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

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

-- divisores 16 == [1,2,4,8,16]

divisores :: Integer -> [Integer]

divisores n =

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

-- 2ª definición

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

nDivisoresPar2 :: Integer -> Bool

nDivisoresPar2 n =

any odd (map length (group (primeFactors n)))

-- Comparación de eficiencia

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

-- λ> nDivisoresPar1 (10^7)

-- True

-- (14.18 secs, 2,078,736,992 bytes)

-- λ> nDivisoresPar2 (10^7)

-- True

-- (0.01 secs, 0 bytes)

-- λ> nDivisoresPar2 (product [1..2*10^4])

-- True

-- (2.30 secs, 1,003,013,112 bytes)

Solución en Maxima

/* concat(xs) es la lista obtenida concatenado los elementos de xss. Por
   ejemplo,
      concat([[1,3],[2,4],[5,7]])  ==  [1, 3, 2, 4, 5, 7]             */
concat (xs) := block ([r:[]],
  for x in reverse (xs) do r : append (x,r),
  r)$

nDivisoresPares (n) := block(
  [xs : concat (map (rest, ifactors (n))), p : false],
  for x in xs do p: oddp (x) or p,
  p)$

/* concat(xs) es la lista obtenida concatenado los elementos de xss. Por

ejemplo,

concat([[1,3],[2,4],[5,7]]) == [1, 3, 2, 4, 5, 7] */

concat (xs) := block ([r:[]],

for x in reverse (xs) do r : append (x,r),

r)$

nDivisoresPares (n) := block(

[xs : concat (map (rest, ifactors (n))), p : false],

for x in xs do p: oddp (x) or p,

p)$

Máxima longitud de las sublistas comunes

PorJosé A. Alonso 9-marzo-201616-marzo-2016

Las sublistas comunes de «1325» y «36572» son «», «3»,»32″, «35», «2» y «5». El máximo de sus longitudes es 2.

Definir la función

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

1	maximo :: Eq a => [a] -> [a] -> Int

tal que (maximo xs ys) es el máximo de las longitudes de las sublistas comunes de xs e ys. Por ejemplo,

   maximo "1325" "36572"       == 2
   maximo [1,4..33] [2,4..33]  == 5
   maximo [1..10^6] [1..10^6]  == 100000

maximo "1325" "36572" == 2

maximo [1,4..33] [2,4..33] == 5

maximo [1..10^6] [1..10^6] == 100000

Soluciones

import Data.List (subsequences, intersect)

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

maximo1 :: Eq a => [a] -> [a] -> Int
maximo1 xs ys = 
    maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e
-- ys. Por ejemplo,
sublistasComunes :: Eq a => [a] -> [a] -> [[a]]
sublistasComunes xs ys =
    subsequences xs `intersect` subsequences ys

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

maximo2 :: Eq a => [a] -> [a] -> Int
maximo2 l1@(x:xs) l2@(y:ys) 
    | x == y    = 1 + maximo2 xs ys
    | otherwise = max (maximo2 xs l2) (maximo2 l1 ys)  
maximo2 _ _ = 0

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

--    λ> maximo1 [1,4..30] [2,4..30]
--    5
--    (3.60 secs, 0 bytes)
--    λ> maximo2 [1,4..30] [2,4..30]
--    5
--    (1.58 secs, 216,347,472 bytes)
--    
--    λ> maximo2 [1..10^6] [1..10^6]
--    1000000
--    (2.44 secs, 407,051,096 bytes)

import Data.List (subsequences, intersect)

-- 1ª definición

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

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

maximo1 xs ys =

maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e

-- ys. Por ejemplo,

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

sublistasComunes xs ys =

subsequences xs `intersect` subsequences ys

-- 2ª definición

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

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

maximo2 l1@(x:xs) l2@(y:ys)

| x == y = 1 + maximo2 xs ys

| otherwise = max (maximo2 xs l2) (maximo2 l1 ys)

maximo2 _ _ = 0

-- Comparación de eficiencia

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

-- λ> maximo1 [1,4..30] [2,4..30]

-- 5

-- (3.60 secs, 0 bytes)

-- λ> maximo2 [1,4..30] [2,4..30]

-- 5

-- (1.58 secs, 216,347,472 bytes)

-- λ> maximo2 [1..10^6] [1..10^6]

-- 1000000

-- (2.44 secs, 407,051,096 bytes)

Elemento ausente

PorJosé A. Alonso 8-marzo-20162-mayo-2016

Sea xs una lista y n su longitud. Se dice que xs es casi completa si sus elementos son los números enteros entre 0 y n excepto uno. Por ejemplo, la lista [3,0,1] es casi completa.

Definir la función

   ausente :: [Integer] -> Integer

1	ausente :: [Integer] -> Integer

tal que (ausente xs) es el único entero (entre 0 y la longitud de xs) que no pertenece a la lista casi completa xs. Por ejemplo,

   ausente [3,0,1]               ==  2
   ausente [1,2,0]               ==  3
   ausente (1+10^7:[0..10^7-1])  ==  10000000

ausente [3,0,1] == 2

ausente [1,2,0] == 3

ausente (1+10^7:[0..10^7-1]) == 10000000

Soluciones

import Data.List (foldl', genericLength)
import Data.Set (fromList, notMember)
    
-- 1ª definición
ausente1 :: [Integer] -> Integer
ausente1 xs =
    head [n | n <- [0..], n `notElem` xs]

-- 2ª definición
ausente2 :: [Integer] -> Integer
ausente2 xs =
    head [n | n <- [0..], n `notMember` ys]
    where ys = fromList xs
         
-- 3ª definición (lineal)
ausente3 :: [Integer] -> Integer
ausente3 xs =
    ((n * (n+1)) `div` 2) - sum xs
    where n = genericLength xs  

-- 4ª definición
ausente4 :: [Integer] -> Integer
ausente4 xs =
    ((n * (n+1)) `div` 2) - foldl' (+) 0 xs
    where n = genericLength xs  

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

--    λ> let n = 10^5 in ausente1 (n+1:[0..n-1])
--    100000
--    (68.51 secs, 25,967,840 bytes)
--    λ> let n = 10^5 in ausente2 (n+1:[0..n-1])
--    100000
--    (0.12 secs, 123,488,144 bytes)
--    λ> let n = 10^5 in ausente3 (n+1:[0..n-1])
--    100000
--    (0.07 secs, 30,928,384 bytes)
--    λ> let n = 10^5 in ausente4 (n+1:[0..n-1])
--    100000
--    (0.02 secs, 23,039,904 bytes)
--    
--    λ> let n = 10^7 in ausente2 (n+1:[0..n-1])
--    10000000
--    (14.32 secs, 15,358,509,280 bytes)
--    λ> let n = 10^7 in ausente3 (n+1:[0..n-1])
--    10000000
--    (5.57 secs, 2,670,214,936 bytes)
--    λ> let n = 10^7 in ausente4 (n+1:[0..n-1])
--    10000000
--    (3.36 secs, 2,074,919,184 bytes)

import Data.List (foldl', genericLength)

import Data.Set (fromList, notMember)

-- 1ª definición

ausente1 :: [Integer] -> Integer

ausente1 xs =

head [n | n <- [0..], n `notElem` xs]

-- 2ª definición

ausente2 :: [Integer] -> Integer

ausente2 xs =

head [n | n <- [0..], n `notMember` ys]

where ys = fromList xs

-- 3ª definición (lineal)

ausente3 :: [Integer] -> Integer

ausente3 xs =

((n * (n+1)) `div` 2) - sum xs

where n = genericLength xs

-- 4ª definición

ausente4 :: [Integer] -> Integer

ausente4 xs =

((n * (n+1)) `div` 2) - foldl' (+) 0 xs

where n = genericLength xs

-- Comparación de eficiencia

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

-- λ> let n = 10^5 in ausente1 (n+1:[0..n-1])

-- 100000

-- (68.51 secs, 25,967,840 bytes)

-- λ> let n = 10^5 in ausente2 (n+1:[0..n-1])

-- 100000

-- (0.12 secs, 123,488,144 bytes)

-- λ> let n = 10^5 in ausente3 (n+1:[0..n-1])

-- 100000

-- (0.07 secs, 30,928,384 bytes)

-- λ> let n = 10^5 in ausente4 (n+1:[0..n-1])

-- 100000

-- (0.02 secs, 23,039,904 bytes)

-- λ> let n = 10^7 in ausente2 (n+1:[0..n-1])

-- 10000000

-- (14.32 secs, 15,358,509,280 bytes)

-- λ> let n = 10^7 in ausente3 (n+1:[0..n-1])

-- 10000000

-- (5.57 secs, 2,670,214,936 bytes)

-- λ> let n = 10^7 in ausente4 (n+1:[0..n-1])

-- 10000000

-- (3.36 secs, 2,074,919,184 bytes)

Menor no expresable como suma

PorJosé A. Alonso 7-marzo-201625-abril-2021

Definir la función

   menorNoSuma :: [Integer] -> Integer

1	menorNoSuma :: [Integer] -> Integer

tal que (menorNoSuma xs) es el menor número que no se puede escribir como suma de un subconjunto de xs, donde se supone que xs es un conjunto de números enteros positivos. Por ejemplo,

   menorNoSuma [6,1,2]    ==  4
   menorNoSuma [1,2,3,9]  ==  7
   menorNoSuma [5]        ==  1
   menorNoSuma [1..20]    ==  211
   menorNoSuma [1..10^6]  ==  500000500001

menorNoSuma [6,1,2] == 4

menorNoSuma [1,2,3,9] == 7

menorNoSuma [5] == 1

menorNoSuma [1..20] == 211

menorNoSuma [1..10^6] == 500000500001

Comprobar con QuickCheck que para todo n,

   menorNoSuma [1..n] == 1 + sum [1..n]

1	menorNoSuma [1..n] == 1 + sum [1..n]

Soluciones

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

import Data.List (sort, subsequences)
import Test.QuickCheck
    
menorNoSuma1 :: [Integer] -> Integer
menorNoSuma1 xs =
  head [n | n <- [1..], n `notElem` sumas xs]

-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,
--    sumas [1,2,6]  ==  [0,1,2,3,6,7,8,9]
--    sumas [6,1,2]  ==  [0,6,1,7,2,8,3,9]
sumas :: [Integer] -> [Integer]
sumas xs = map sum (subsequences xs)

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

menorNoSuma2 :: [Integer] -> Integer
menorNoSuma2  = menorNoSumaOrd . reverse . sort 

-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como
-- suma de un subconjunto de xs, donde xs es una lista de números
-- naturales ordenada de mayor a menor. Por ejemplo,
--    menorNoSumaOrd [6,2,1]  ==  4
menorNoSumaOrd [] = 1
menorNoSumaOrd (x:xs) | x > y     = y
                      | otherwise = y+x
    where y = menorNoSumaOrd xs

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

--    λ> menorNoSuma1 [1..20]
--    211
--    (20.40 secs, 28,268,746,320 bytes)
--    λ> menorNoSuma2 [1..20]
--    211
--    (0.01 secs, 0 bytes)
           
-- Propiedad
-- =========

-- La propiedad es
prop_menorNoSuma :: (Positive Integer) -> Bool
prop_menorNoSuma (Positive n) =
    menorNoSuma2 [1..n] == 1 + sum [1..n]

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

-- 1ª definición

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

import Data.List (sort, subsequences)

import Test.QuickCheck

menorNoSuma1 :: [Integer] -> Integer

menorNoSuma1 xs =

head [n | n <- [1..], n `notElem` sumas xs]

-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,

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

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

sumas :: [Integer] -> [Integer]

sumas xs = map sum (subsequences xs)

-- 2ª definición

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

menorNoSuma2 :: [Integer] -> Integer

menorNoSuma2 = menorNoSumaOrd . reverse . sort

-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como

-- suma de un subconjunto de xs, donde xs es una lista de números

-- naturales ordenada de mayor a menor. Por ejemplo,

-- menorNoSumaOrd [6,2,1] == 4

menorNoSumaOrd [] = 1

menorNoSumaOrd (x:xs) | x > y = y

| otherwise = y+x

where y = menorNoSumaOrd xs

-- Comparación de eficiencia

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

-- λ> menorNoSuma1 [1..20]

-- 211

-- (20.40 secs, 28,268,746,320 bytes)

-- λ> menorNoSuma2 [1..20]

-- 211

-- (0.01 secs, 0 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_menorNoSuma :: (Positive Integer) -> Bool

prop_menorNoSuma (Positive n) =

menorNoSuma2 [1..n] == 1 + sum [1..n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma

-- +++ OK, passed 100 tests.

Números N cuyos cuadrados tienen dos copias de cada dígito de N

PorJosé A. Alonso 3-marzo-201610-marzo-2016

La sucesión A114258 de la OEIS está formada por los números n tales que el número de ocurrencia de cada dígito d de n en n² es el doble del número de ocurrencia de d en n. Por ejemplo, 72576 es un elemento de A114258 porque tiene un 2, un 5, un 6 y dos 7 y su cuadrado es 5267275776 que tiene exactamente dos 2, dos 5, dos 6 y cuatro 7.

Un número es especial si pertenece a la sucesión A114258.

Definir la sucesión

   especiales :: [Integer]

1	especiales :: [Integer]

cuyos elementos son los números especiales. Por ejemplo,

   take 5 especiales  ==  [72576,406512,415278,494462,603297]

1	take 5 especiales == [72576,406512,415278,494462,603297]

Soluciones

import Data.List (sort)

especiales :: [Integer]
especiales = filter especial [1..]

especial :: Integer -> Bool
especial x = sort (ys ++ ys) == sort (show (x^2))
    where ys = show x

import Data.List (sort)

especiales :: [Integer]

especiales = filter especial [1..]

especial :: Integer -> Bool

especial x = sort (ys ++ ys) == sort (show (x^2))

where ys = show x

En Maxima

especiales (n) := block ([k:0, r:[], i:1],
  while k < n do
    ( if especial (i)
      then (r : cons (i,r), k : k+1),
      i : i+1),
  reverse (r))$
  
especial (n) := block([ys],
  ys : string(n),
  is (ssort (sconcat(ys,ys)) = ssort (string (n^2))))$

/*
   (%i15) showtime : true$
   Evaluation took 0.0000 seconds (0.0000 elapsed)
   (%i16) especiales (5);
   Evaluation took 29.4800 seconds (29.5400 elapsed)
   (%o16) [72576, 406512, 415278, 494462, 603297]
*/

especiales (n) := block ([k:0, r:[], i:1],

while k < n do

( if especial (i)

then (r : cons (i,r), k : k+1),

i : i+1),

reverse (r))$

especial (n) := block([ys],

ys : string(n),

is (ssort (sconcat(ys,ys)) = ssort (string (n^2))))$

(%i15) showtime : true$

Evaluation took 0.0000 seconds (0.0000 elapsed)

(%i16) especiales (5);

Evaluation took 29.4800 seconds (29.5400 elapsed)

(%o16) [72576, 406512, 415278, 494462, 603297]

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones en Maxima

Soluciones

Solución en Maxima

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Solución en Maxima

Soluciones

Soluciones

Soluciones

Soluciones

En Maxima

Entradas recientes

Buscar

Correo electrónico