Recursión

El algoritmo binario del mcd

PorJosé A. Alonso 1-febrero-20168-febrero-2016

El máximo común divisor (mcd) de dos números enteros no negativos se puede calcular mediante un algoritmo binario basado en las siguientes propiedades:

Si a,b son pares, entonces mcd(a,b) = 2*mcd(a/2,b/2)
Si a es par y b impar, entonces mcd(a,b) = mcd(a/2,b)
Si a es impar y b par, entonces mcd(a,b) = mcd(a,b/2)
Si a y b son impares y a > b, entonces mcd(a,b) = mcd((a-b)/2,b)
Si a y b son impares y a < b, entonces mcd(a,b) = mcd(a,(b-a)/2)
mcd(a,0) = a
mcd(0,b) = b
mcd(a,a) = a

Por ejemplo, el cálculo del mcd(660,420) es

   mcd(660,420)
   = 2*mcd(330,210)    [por 1]
   = 2*2*mcd(165,105)  [por 1]
   = 2*2*mcd(30,105)   [por 4]
   = 2*2*mcd(15,105)   [por 2]
   = 2*2*mcd(15,45)    [por 4]
   = 2*2*mcd(15,15)    [por 4]
   = 2*2*15            [por 8]
   = 60

mcd(660,420)

= 2*mcd(330,210) [por 1]

= 2*2*mcd(165,105) [por 1]

= 2*2*mcd(30,105) [por 4]

= 2*2*mcd(15,105) [por 2]

= 2*2*mcd(15,45) [por 4]

= 2*2*mcd(15,15) [por 4]

= 2*2*15 [por 8]

= 60

Definir la función

   mcd :: Integer -> Integer -> Integer

1	mcd :: Integer -> Integer -> Integer

Definir la función

tal que (mcd a b) es el máximo común divisor de a y b calculado mediante el algoritmo binario del mcd. Por ejemplo,

   mcd 660 420  ==  60
   mcd 3 0      ==  3
   mcd 0 3      ==  3

mcd 660 420 == 60

mcd 3 0 == 3

mcd 0 3 == 3

Comprobar con QuickCheck que, para los enteros no negativos, las funciones mcd y gcd son equivalentes.

Soluciones

import Test.QuickCheck

mcd :: Integer -> Integer -> Integer
mcd a 0 = a
mcd 0 b = b
mcd a b | a == b           = a
        | even a && even b = 2 * mcd (a `div` 2) (b `div` 2)
        | even a           = mcd (a `div` 2)     b
        | even b           = mcd a               (b `div` 2)
        | a > b            = mcd ((a-b) `div` 2) b
        | otherwise        = mcd a               ((b-a) `div` 2)

-- Propiedad de equivalencia 
prop_mcd :: Integer -> Integer -> Bool
prop_mcd a b = mcd a1 b1 == gcd a1 b1
    where a1 = abs a
          b1 = abs b

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

import Test.QuickCheck

mcd :: Integer -> Integer -> Integer

mcd a 0 = a

mcd 0 b = b

mcd a b | a == b = a

| even a && even b = 2 * mcd (a `div` 2) (b `div` 2)

| even a = mcd (a `div` 2) b

| even b = mcd a (b `div` 2)

| a > b = mcd ((a-b) `div` 2) b

| otherwise = mcd a ((b-a) `div` 2)

-- Propiedad de equivalencia

prop_mcd :: Integer -> Integer -> Bool

prop_mcd a b = mcd a1 b1 == gcd a1 b1

where a1 = abs a

b1 = abs b

-- La comprobación es

-- λ> quickCheck prop_mcd

-- +++ OK, passed 100 tests.

Agrupamiento por propiedad

PorJosé A. Alonso 29-enero-20165-febrero-2016

Definir la función

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

1	agrupa :: (a -> Bool) -> [a] -> [[a]]

tal que (agrupa p xs) es la lista obtenida separando los elementos consecutivos de xs que verifican la propiedad p de los que no la verifican. Por ejemplo,

   agrupa odd   [1,2,0,4,9,6,4,5,7,2]  ==  [[1],[2,0,4],[9],[6,4],[5,7],[2]]
   agrupa even  [1,2,0,4,9,6,4,5,7,2]  ==  [[],[1],[2,0,4],[9],[6,4],[5,7],[2]]
   agrupa (> 4) [1,2,0,4,9,6,4,5,7,2]  ==  [[],[1,2,0,4],[9,6],[4],[5,7],[2]]
   agrupa (< 4) [1,2,0,4,9,6,4,5,7,2]  ==  [[1,2,0],[4,9,6,4,5,7],[2]]

agrupa odd [1,2,0,4,9,6,4,5,7,2] == [[1],[2,0,4],[9],[6,4],[5,7],[2]]

agrupa even [1,2,0,4,9,6,4,5,7,2] == [[],[1],[2,0,4],[9],[6,4],[5,7],[2]]

agrupa (> 4) [1,2,0,4,9,6,4,5,7,2] == [[],[1,2,0,4],[9,6],[4],[5,7],[2]]

agrupa (< 4) [1,2,0,4,9,6,4,5,7,2] == [[1,2,0],[4,9,6,4,5,7],[2]]

Comprobar con QuickCheck que para cualquier propiedad p y cualquier lista xs, la concatenación de (agrupa p xs) es xs; es decir,

   prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool
   prop_agrupa (Blind p) xs =
       concat (agrupa1 p xs) == xs

prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool

prop_agrupa (Blind p) xs =

concat (agrupa1 p xs) == xs

Nota. Usar la librería Test.QuickCheck.Modifiers.

Soluciones

import Test.QuickCheck
import Test.QuickCheck.Modifiers

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

agrupa1 :: (a -> Bool) -> [a] -> [[a]]
agrupa1 p [] = []
agrupa1 p xs = takeWhile p xs : agrupa1 (not . p) (dropWhile p xs)

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

agrupa2 :: (a -> Bool) -> [a] -> [[a]]
agrupa2 p [] = []
agrupa2 p xs = ys : agrupa2 (not . p) zs
    where (ys,zs) = span p xs

-- Propiedad
-- =========

-- La propiedad es
prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool
prop_agrupa (Blind p) xs =
    concat (agrupa1 p xs) == xs

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

import Test.QuickCheck

import Test.QuickCheck.Modifiers

-- 1ª solución

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

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

agrupa1 p [] = []

agrupa1 p xs = takeWhile p xs : agrupa1 (not . p) (dropWhile p xs)

-- 2ª solución

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

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

agrupa2 p [] = []

agrupa2 p xs = ys : agrupa2 (not . p) zs

where (ys,zs) = span p xs

-- Propiedad

-- =========

-- La propiedad es

prop_agrupa :: Blind (Int -> Bool) -> [Int] -> Bool

prop_agrupa (Blind p) xs =

concat (agrupa1 p xs) == xs

-- La comprobación es

-- λ> quickCheck prop_agrupa

-- +++ OK, passed 100 tests.

De árboles a listas

PorJosé A. Alonso 27-enero-20163-febrero-2016

Los árboles binarios con datos en nodos y hojas se definen por

   data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

1	data Arbol a = H a \| N a (Arbol a) (Arbol a) deriving Show

Por ejemplo, el árbol

          3
         / \
        /   \
       4     7
      / \   / \
     5   0 0   3
    / \
   2   0

/ \

4 7

/ \ / \

5 0 0 3

/ \

2 0

se representa por

   ejArbol :: Arbol Integer
   ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

1 2	ejArbol :: Arbol Integer ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

Definir la función

   sucesores :: Arbol a -> [(a,[a])]

1	sucesores :: Arbol a -> [(a,[a])]

tal que (sucesores t) es la lista de los pares formados por los elementos del árbol t junto con sus sucesores. Por ejemplo,

   λ> sucesores ejArbol
   [(3,[4,7]),(4,[5,0]),(5,[2,0]),(2,[]),(0,[]),(0,[]),
    (7,[0,3]),(0,[]),(3,[])]

λ> sucesores ejArbol

[(3,[4,7]),(4,[5,0]),(5,[2,0]),(2,[]),(0,[]),(0,[]),

(7,[0,3]),(0,[]),(3,[])]

Soluciones

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ejArbol :: Arbol Integer
ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

sucesores :: Arbol a -> [(a,[a])]
sucesores (H x)     = [(x,[])]
sucesores (N x i d) = (x, [raiz i, raiz d]) : sucesores i ++ sucesores d

raiz :: Arbol a -> a
raiz (H x)      = x
raiz (N x _ _ ) = x

data Arbol a = H a | N a (Arbol a) (Arbol a) deriving Show

ejArbol :: Arbol Integer

ejArbol = N 3 (N 4 (N 5 (H 2)(H 0)) (H 0)) (N 7 (H 0) (H 3))

sucesores :: Arbol a -> [(a,[a])]

sucesores (H x) = [(x,[])]

sucesores (N x i d) = (x, [raiz i, raiz d]) : sucesores i ++ sucesores d

raiz :: Arbol a -> a

raiz (H x) = x

raiz (N x _ _ ) = x

Conjunto de funciones

PorJosé A. Alonso 26-enero-20162-febrero-2016

Una función f entre dos conjuntos A e B se puede representar mediante una lista de pares de AxB tales que para cada elemento a de A existe un único elemento b de B tal que (a,b) pertenece a f. Por ejemplo,

[(1,2),(3,6)] es una función de [1,3] en [2,4,6];
[(1,2)] no es una función de [1,3] en [2,4,6], porque no tiene ningún par cuyo primer elemento sea igual a 3;
[(1,2),(3,6),(1,4)] no es una función porque hay dos pares distintos cuya primer elemento es 1.

Definir la función

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

1	funciones :: [a] -> [a] -> [[(a,a)]]

tal que (funciones xs ys) es el conjunto de las funciones de xs en ys. Por ejemplo,

   λ> funciones [] [2,4,6]
   [[]]
   λ> funciones [3] [2,4,6]
   [[(3,2)],[(3,4)],[(3,6)]]
   λ> funciones [1,3] [2,4,6]
   [[(1,2),(3,2)], [(1,2),(3,4)], [(1,2),(3,6)], [(1,4),(3,2)], [(1,4),(3,4)],
    [(1,4),(3,6)], [(1,6),(3,2)], [(1,6),(3,4)], [(1,6),(3,6)]]

λ> funciones [] [2,4,6]

[[]]

λ> funciones [3] [2,4,6]

[[(3,2)],[(3,4)],[(3,6)]]

λ> funciones [1,3] [2,4,6]

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

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

Comprobar con QuickCheck que si xs es un conjunto con n elementos e ys un conjunto con m elementos, entonces (funciones xs ys) tiene m^n elementos.

Nota. Al hacer la comprobación limitar el tamaño de las pruebas como se indica a continuación

   λ> quickCheckWith (stdArgs {maxSize=7}) prop_funciones
   +++ OK, passed 100 tests.

1 2	λ> quickCheckWith (stdArgs {maxSize=7}) prop_funciones +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

funciones :: [a] -> [a] -> [[(a,a)]]
funciones [] _      = [[]]
funciones (x:xs) ys = [((x,y):f) | y <- ys, f <- fs]
    where fs = funciones xs ys

prop_funciones :: [Int] -> [Int] -> Bool
prop_funciones xs ys =
    length (funciones xs ys) == (length ys)^(length xs)

import Test.QuickCheck

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

funciones [] _ = [[]]

funciones (x:xs) ys = [((x,y):f) | y <- ys, f <- fs]

where fs = funciones xs ys

prop_funciones :: [Int] -> [Int] -> Bool

prop_funciones xs ys =

length (funciones xs ys) == (length ys)^(length xs)

Puntos visibles en la cuadrícula de un plano

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

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

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

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

Definir la función

   nVisibles :: Integer -> Integer

1	nVisibles :: Integer -> Integer

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

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

nVisibles 6 == 23

nVisibles 10 == 63

nVisibles 100 == 6087

nVisibles 1000 == 608383

nVisibles 10000 == 60794971

nVisibles 100000 == 6079301507

Soluciones

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

type Punto = (Integer,Integer)

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

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

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

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

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

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

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

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


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

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

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

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

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

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

import Data.List (genericLength, group, sort)

import Data.Numbers.Primes (primeFactors)

type Punto = (Integer,Integer)

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

-- visible (4,5) == True

-- visible (4,6) == False

visible :: Punto -> Bool

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

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

-- de lado 1. Por ejemplo,

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

-- λ> sort (visibles 6)

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

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

-- 1ª definición de visibles

visibles1 :: Integer -> [Punto]

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

-- 2ª definición de visibles

visibles2 :: Integer -> [Punto]

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

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

-- Comparación de eficiencia

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

-- λ> length (visibles1 1000)

-- 608383

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

-- λ> length (visibles2 1000)

-- 608383

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

-- Usaremos la 2ª definición de visibles

visibles :: Integer -> [Punto]

visibles = visibles2

-- 1ª definición de nVisibles

nVisibles1 :: Integer -> Integer

nVisibles1 = genericLength . visibles

-- 2ª definición de nVisibles

nVisibles2 :: Integer -> Integer

nVisibles2 n =

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

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

visible (x,y)]

-- 3ª definición de nVisibles

nVisibles3 :: Integer -> Integer

nVisibles3 1 = 1

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

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

phi :: Integer -> Integer

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

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

factorizacion n =

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

-- 4ª definición de nVisibles

nVisibles4 :: Integer -> Integer

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

-- Comparación de eficiencia

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

-- λ> nVisibles1 1000

-- 608383

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

-- λ> nVisibles2 1000

-- 608383

-- λ> nVisibles3 1000

-- 608383

-- (0.05 secs, 0 bytes)

-- λ> nVisibles4 1000

-- 608383

-- (0.04 secs, 0 bytes)

Referencias

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

Fórmula dual

PorJosé A. Alonso 7-enero-201615-enero-2016

Las fórmulas proposicionales construidas con las constantes verdadero (⊤), falso (⊥), las variables proposicionales y las conectivas de negación (¬), conjunción (∧) y disyunción (∨) se pueden definir usando el siguiente tipo de datos

   data Prop = Const Bool
             | Var Char
             | Neg Prop
             | Conj Prop Prop
             | Disj Prop Prop
             deriving (Eq, Show)

data Prop = Const Bool

| Var Char

| Neg Prop

| Conj Prop Prop

| Disj Prop Prop

deriving (Eq, Show)

Por ejemplo, la fórmula (A ∧ ⊥) ∨ (⊤ ∧ B) se representa por

   Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B'))

1	Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B'))

La fórmula dual de una fórmula p es la fórmula obtenida intercambiando en p las ∧ por ∨ y también las ⊤ por ⊥. Por ejemplo, la dual de (A ∧ ⊥) ∨ (⊤ ∧ B) es (A ∨ ⊤) ∧ (⊥ ∨ B)

Definir la función

   dual :: Prop -> Prop

1	dual :: Prop -> Prop

tal que (dual p) es la dual de p. Por ejemplo,

   λ> dual (Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B')))
   Conj (Disj (Var 'A') (Const True)) (Disj (Const False) (Var 'B'))

1 2	λ> dual (Disj (Conj (Var 'A') (Const False)) (Conj (Const True) (Var 'B'))) Conj (Disj (Var 'A') (Const True)) (Disj (Const False) (Var 'B'))

Soluciones

data Prop = Const Bool
          | Var Char
          | Neg Prop
          | Conj Prop Prop
          | Disj Prop Prop
          deriving (Eq, Show)

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

dual1 :: Prop -> Prop
dual1 (Const True)  = Const False
dual1 (Const False) = Const True
dual1 (Var x)       = Var x
dual1 (Neg p)       = Neg  (dual1 p)
dual1 (Conj p q)    = Disj (dual1 p) (dual1 q) 
dual1 (Disj p q)    = Conj (dual1 p) (dual1 q) 

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

dual2 :: Prop -> Prop
dual2 (Const b)  = Const (not b)
dual2 (Conj p q) = Disj (dual2 p) (dual2 q)
dual2 (Disj p q) = Conj (dual2 p) (dual2 q)
dual2 p          = p

data Prop = Const Bool

| Var Char

| Neg Prop

| Conj Prop Prop

| Disj Prop Prop

deriving (Eq, Show)

-- 1ª solución

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

dual1 :: Prop -> Prop

dual1 (Const True) = Const False

dual1 (Const False) = Const True

dual1 (Var x) = Var x

dual1 (Neg p) = Neg (dual1 p)

dual1 (Conj p q) = Disj (dual1 p) (dual1 q)

dual1 (Disj p q) = Conj (dual1 p) (dual1 q)

-- 2ª solución

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

dual2 :: Prop -> Prop

dual2 (Const b) = Const (not b)

dual2 (Conj p q) = Disj (dual2 p) (dual2 q)

dual2 (Disj p q) = Conj (dual2 p) (dual2 q)

dual2 p = p

Puntos en una región

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

Definir la función

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

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

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

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

length (puntos 10) == 5

length (puntos 100) == 10

length (puntos 1000) == 15

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

-- 1ª definición

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

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

puntos1 n =

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

y <- [1..n],

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

-- 2ª definición

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

-- Calculando algunos elementos

-- λ> puntos1 10

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

-- λ> puntos1 20

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

-- λ> puntos1 100

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

-- λ> puntos1 89

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

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

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

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

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

menor (x,y) = x <= n

-- 3ª definición

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

-- Se observa que la lista de las segundas componentes

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

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

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

puntos3 n = zip (tail xs) xs

where xs = takeWhile (<=n) fibonacci

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

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

fibonacci :: [Integer]

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

-- Comparación de eficiencia

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

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

-- 15

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

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

-- 15

-- (0.02 secs, 0 bytes)

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

-- 143549

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

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

-- 143549

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

2016 es un número práctico

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

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

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

1 = 1

2 = 2

3 = 3

4 = 4

5 = 2 + 3

6 = 6

7 = 1 + 6

8 = 2 + 6

9 = 3 + 6

10 = 4 + 6

11 = 1 + 4 + 6

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

Definir la función

   esPractico :: Integer -> Bool

1	esPractico :: Integer -> Bool

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

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

esPractico 12 == True

esPractico 14 == False

esPractico 2016 == True

esPractico 42535295865117307932921825928971026432 == True

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

esPractico1 :: Integer -> Bool

esPractico1 n =

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

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

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

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

divisores :: Integer -> [Integer]

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

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

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

-- cada suma. Por ejemplo,

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

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

sumas :: [Integer] -> [Integer]

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

-- 2ª definición

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

esPractico2 :: Integer -> Bool

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

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

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

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

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

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

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

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

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

esSumable _ 0 = True

esSumable [] _ = False

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

-- 3ª definición

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

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

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

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

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

-- 1+e(j)

-- i-1 p(j) - 1

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

-- j=1 p(j) - 1

esPractico3 :: Integer -> Bool

esPractico3 1 = True

esPractico3 n =

x == 2 &&

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

where xss = factorizacion n

(x:bases) = map fst xss

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

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

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

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

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

factorizacion n =

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

-- Comparación de eficiencia

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

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

-- 92

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

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

-- 92

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

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

-- 92

-- (0.02 secs, 0 bytes)

Referencias

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

Otras referencias

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

Reconocimiento de anterior

PorJosé A. Alonso 29-diciembre-20151-mayo-2016

Definir la función

   esAnterior :: Eq a => [a] -> a -> a -> Bool

1	esAnterior :: Eq a => [a] -> a -> a -> Bool

tal que (esAnterior xs y z) se verifica si y ocurre en xs antes que z (que puede no pertenecer a xs). Por ejemplo,

   esAnterior [1,3,7,2] 3 2  ==  True
   esAnterior [1,3,7,2] 3 1  ==  False
   esAnterior [1,3,7,2] 3 5  ==  True
   esAnterior [1,3,7,2] 5 3  ==  False

esAnterior [1,3,7,2] 3 2 == True

esAnterior [1,3,7,2] 3 1 == False

esAnterior [1,3,7,2] 3 5 == True

esAnterior [1,3,7,2] 5 3 == False

Soluciones

-- 1ª definición (por recursión)
esAnterior1 :: Eq a => [a] -> a -> a -> Bool
esAnterior1 [] _ _     = False
esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z) 

-- 2ª definición
esAnterior2 :: Eq a => [a] -> a -> a -> Bool
esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia
--    λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n
--    True
--    (2.19 secs, 384,717,008 bytes)
--    λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n
--    True
--    (0.34 secs, 135,479,936 bytes)

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

esAnterior1 :: Eq a => [a] -> a -> a -> Bool

esAnterior1 [] _ _ = False

esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z)

-- 2ª definición

esAnterior2 :: Eq a => [a] -> a -> a -> Bool

esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia

-- λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n

-- True

-- (2.19 secs, 384,717,008 bytes)

-- λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n

-- True

-- (0.34 secs, 135,479,936 bytes)

Operación sobre todos los pares

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

Definir la función

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

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

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

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

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

Soluciones

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

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

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

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

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

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

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

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

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

todosPares2 _ [] _ = []

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

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

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

todosPares3 f xs ys = aux xs where

aux [] = []

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

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

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

todosPares4 f xs ys =

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

El algoritmo binario del mcd

Soluciones

Agrupamiento por propiedad

Soluciones

De árboles a listas

Soluciones

Conjunto de funciones

Soluciones

Fórmula dual

Soluciones

Puntos en una región

Soluciones

Reconocimiento de anterior

Soluciones

Operación sobre todos los pares

Soluciones

Entradas recientes

Buscar

Correo electrónico