Recursión – Página 13

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

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.

Integración por el método de los rectángulos

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

La integral definida de una función f entre los límites a y b puede calcularse mediante la regla del rectángulo usando la fórmula

   h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

1	h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

con a+nh+h/2 ≤ b < a+(n+1)h+h/2 y usando valores pequeños para h.

Definir la función

   integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

1	integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

tal que (integral a b f h) es el valor de dicha expresión. Por ejemplo, el cálculo de la integral de f(x) = x^3 entre 0 y 1, con paso 0.01, es

   integral 0 1 (^3) 0.01  ==  0.24998750000000042

1	integral 0 1 (^3) 0.01 == 0.24998750000000042

Otros ejemplos son

   integral 0 1 (^4) 0.01                        ==  0.19998333362500048
   integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01       ==  1.9999250000000026
   log 2 - integral 1 2 (\x -> 1/x) 0.01         ==  3.124931644782336e-6
   pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01  ==  -8.333333331389525e-6

integral 0 1 (^4) 0.01 == 0.19998333362500048

integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01 == 1.9999250000000026

log 2 - integral 1 2 (\x -> 1/x) 0.01 == 3.124931644782336e-6

pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01 == -8.333333331389525e-6

Nota: Definir la función también en Maxima. Por ejemplo,

   (%i3) integral (0,1,lambda ([x],x^3),0.01);
   (%o3) 0.2499875

1 2	(%i3) integral (0,1,lambda ([x],x^3),0.01); (%o3) 0.2499875

Soluciones

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de
--    f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    suma 2 5 (1+) (^3)  ==  224
suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a
suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista
--    [a, s(a), s(s(a), ..., s(...(s(a))...)]
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    sucesion 3 20 (+2)  ==  [3,5,7,9,11,13,15,17,19]
sucesion :: Ord a => a -> a -> (a -> a) -> [a]
sucesion a b s = takeWhile (<=b) (iterate s a)

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral2 a b f h
    | a+h/2 > b = 0
    | otherwise = h * f (a+h/2) + integral2 (a+h) b f h

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral3 a b f h = aux a where
    aux x | x+h/2 > b = 0
          | otherwise = h * f (x+h/2) + aux (x+h)

-- 1ª solución

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de

-- f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- suma 2 5 (1+) (^3) == 224

suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a

suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista

-- [a, s(a), s(s(a), ..., s(...(s(a))...)]

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- sucesion 3 20 (+2) == [3,5,7,9,11,13,15,17,19]

sucesion :: Ord a => a -> a -> (a -> a) -> [a]

sucesion a b s = takeWhile (<=b) (iterate s a)

-- 2ª solución

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral2 a b f h

| a+h/2 > b = 0

| otherwise = h * f (a+h/2) + integral2 (a+h) b f h

-- 3ª solución

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral3 a b f h = aux a where

aux x | x+h/2 > b = 0

| otherwise = h * f (x+h/2) + aux (x+h)

Solución en Maxima

integral (a,b,f,h) := block ([c:a+h/2, s:0],
  while c <= b do
    ( s : s + f(c),
      c : c+h),
  float(h*s))$

integral (a,b,f,h) := block ([c:a+h/2, s:0],

while c <= b do

( s : s + f(c),

c : c+h),

float(h*s))$

Nota: En Maxima esta definida la función integrate para calcular integrales definidas. Por ejemplo,

     (%i7) integrate (x^3,x,0,1);
           1
     (%o7) -
           4
     (%i8) %, numer;
     (%o8) 0.25

(%i7) integrate (x^3,x,0,1);

(%o7) -

(%i8) %, numer;

(%o8) 0.25

Particiones en sumas de cuadrados

PorJosé A. Alonso 26-febrero-20161-mayo-2016

Definir las funciones

   particionesCuadradas        :: Integer -> [[Integer]]
   nParticionesCuadradas       :: Integer -> Integer
   graficaParticionesCuadradas :: Integer -> IO ()

particionesCuadradas :: Integer -> [[Integer]]

nParticionesCuadradas :: Integer -> Integer

graficaParticionesCuadradas :: Integer -> IO ()

tales que

(particionesCuadradas n) es la listas de conjuntos de cuadrados cuya suma es n. Por ejemplo,

      particionesCuadradas 3  ==  [[1,1,1]]
      particionesCuadradas 4  ==  [[4],[1,1,1,1]]
      particionesCuadradas 9  ==  [[9],[4,4,1],[4,1,1,1,1,1],[1,1,1,1,1,1,1,1,1]]

particionesCuadradas 3 == [[1,1,1]]

particionesCuadradas 4 == [[4],[1,1,1,1]]

particionesCuadradas 9 == [[9],[4,4,1],[4,1,1,1,1,1],[1,1,1,1,1,1,1,1,1]]

(nParticionesCuadradas n) es el número de conjuntos de cuadrados cuya suma es n. Por ejemplo,

      nParticionesCuadradas 3    ==  1
      nParticionesCuadradas 4    ==  2
      nParticionesCuadradas 9    ==  4
      nParticionesCuadradas 50   ==  104
      nParticionesCuadradas 100  ==  1116
      nParticionesCuadradas 200  ==  27482

nParticionesCuadradas 3 == 1

nParticionesCuadradas 4 == 2

nParticionesCuadradas 9 == 4

nParticionesCuadradas 50 == 104

nParticionesCuadradas 100 == 1116

nParticionesCuadradas 200 == 27482

(graficaParticionesCuadradas n) dibuja la gráfica de la sucesión

      [nParticionesCuadradas k | k <- [0..n]]

1	[nParticionesCuadradas k \| k <- [0..n]]

Por ejemplo, con (graficaParticionesCuadradas 100) se obtiene

Soluciones

import Data.List (genericLength)
import Graphics.Gnuplot.Simple

-- Definición de particiones cuadradas
-- ===================================

particionesCuadradas :: Integer -> [[Integer]]
particionesCuadradas n = 
    particiones n (reverse $ takeWhile (<=n) cuadrados)

-- cuadrados es la lista de los cuadrados. Por ejemplo,
--    take 12 cuadrados  ==  [1,4,9,16,25,36,49,64,81,100,121,144]
cuadrados :: [Integer]
cuadrados = map (^2) [1..]

-- (particiones n xs) es la lista de las particiones de n como suma de
-- elementos de xs, donde xs es una lista no creciente. Por ejemplo,
--    particiones 10 [7,4,2]  ==  [[4,4,2],[4,2,2,2],[2,2,2,2,2]]
--    particiones 11 [7,4,2]  ==  [[7,4],[7,2,2]]
--    particiones  5 [7,4,2]  ==  []
particiones:: Integer -> [Integer] -> [[Integer]]
particiones _ [] = []
particiones n (x:xs)
    | x >  n    = particiones n xs
    | x == n    = [n] : particiones n xs
    | otherwise = map (x:) (particiones (n-x) (x:xs)) ++ particiones n xs

-- 1ª definición de nParticionesCuadradas       
nParticionesCuadradas1 :: Integer -> Integer
nParticionesCuadradas1 = genericLength . particionesCuadradas

-- 2ª definición nParticionesCuadradas   
nParticionesCuadradas2 :: Integer -> Integer
nParticionesCuadradas2 n = aux n (reverse $ takeWhile (<=n) cuadrados) where
    aux _ [] = 0
    aux n ys@(x:xs) | x >  n    = aux n xs
                    | x == n    = 1 + aux n xs
                    | otherwise = aux (n-x) ys + aux n xs

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

--    λ> nParticionesCuadradas1 250
--    94987
--    (4.21 secs, 3,256,031,528 bytes)
--    λ> nParticionesCuadradas2 250
--    94987
--    (2.93 secs, 1,714,701,504 bytes)

-- Definición de graficaParticionesCuadradas
-- =========================================
                                  
graficaParticionesCuadradas :: Integer  -> IO ()
graficaParticionesCuadradas n = 
    plotList [Key Nothing] [nParticionesCuadradas2 k | k <- [0..n]]

import Data.List (genericLength)

import Graphics.Gnuplot.Simple

-- Definición de particiones cuadradas

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

particionesCuadradas :: Integer -> [[Integer]]

particionesCuadradas n =

particiones n (reverse $ takeWhile (<=n) cuadrados)

-- cuadrados es la lista de los cuadrados. Por ejemplo,

-- take 12 cuadrados == [1,4,9,16,25,36,49,64,81,100,121,144]

cuadrados :: [Integer]

cuadrados = map (^2) [1..]

-- (particiones n xs) es la lista de las particiones de n como suma de

-- elementos de xs, donde xs es una lista no creciente. Por ejemplo,

-- particiones 10 [7,4,2] == [[4,4,2],[4,2,2,2],[2,2,2,2,2]]

-- particiones 11 [7,4,2] == [[7,4],[7,2,2]]

-- particiones 5 [7,4,2] == []

particiones:: Integer -> [Integer] -> [[Integer]]

particiones _ [] = []

particiones n (x:xs)

| x > n = particiones n xs

| x == n = [n] : particiones n xs

| otherwise = map (x:) (particiones (n-x) (x:xs)) ++ particiones n xs

-- 1ª definición de nParticionesCuadradas

nParticionesCuadradas1 :: Integer -> Integer

nParticionesCuadradas1 = genericLength . particionesCuadradas

-- 2ª definición nParticionesCuadradas

nParticionesCuadradas2 :: Integer -> Integer

nParticionesCuadradas2 n = aux n (reverse $ takeWhile (<=n) cuadrados) where

aux _ [] = 0

aux n ys@(x:xs) | x > n = aux n xs

| x == n = 1 + aux n xs

| otherwise = aux (n-x) ys + aux n xs

-- Comparación de eficiencia

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

-- λ> nParticionesCuadradas1 250

-- 94987

-- (4.21 secs, 3,256,031,528 bytes)

-- λ> nParticionesCuadradas2 250

-- 94987

-- (2.93 secs, 1,714,701,504 bytes)

-- Definición de graficaParticionesCuadradas

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

graficaParticionesCuadradas :: Integer -> IO ()

graficaParticionesCuadradas n =

plotList [Key Nothing] [nParticionesCuadradas2 k | k <- [0..n]]

Referencias

Sucesión A001156 de OEIS.

Dígitos en la factorización

PorJosé A. Alonso 19-febrero-20162-marzo-2016

El enunciado del problema 652 de Números y algo más es el siguiente

Si factorizamos los factoriales de un número en función de sus divisores primos y sus potencias, ¿Cuál es el menor número n tal que entre los factores primos y los exponentes de estos, n! contiene los dígitos del cero al nueve? Por ejemplo

6! = 2⁴x3²x5¹, le faltan los dígitos 0,6,7,8 y 9

12! = 2¹⁰x3⁵x5²x7¹x11¹, le faltan los dígitos 4,6,8 y 9

Definir la función

   digitosDeFactorizacion :: Integer -> [Integer]

1	digitosDeFactorizacion :: Integer -> [Integer]

tal que (digitosDeFactorizacion n) es el conjunto de los dígitos que aparecen en la factorización de n. Por ejemplo,

   digitosDeFactorizacion (factorial 6)   ==  [1,2,3,4,5]
   digitosDeFactorizacion (factorial 12)  ==  [0,1,2,3,5,7]

1 2	digitosDeFactorizacion (factorial 6) == [1,2,3,4,5] digitosDeFactorizacion (factorial 12) == [0,1,2,3,5,7]

Usando la función anterior, calcular la solución del problema.

Comprobar con QuickCheck que si n es mayor que 100, entonces

   digitosDeFactorizacion (factorial n) == [0..9]

1	digitosDeFactorizacion (factorial n) == [0..9]

Soluciones

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

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

digitosDeFactorizacion1 :: Integer -> [Integer]
digitosDeFactorizacion1 n =
   sort (nub (concat [digitos x | x <- numerosDeFactorizacion n]))

-- (digitos n) es la lista de los digitos del número n. Por ejemplo, 
--    digitos 320274  ==  [3,2,0,2,7,4]
digitos :: Integer -> [Integer]
digitos n = [read [x] | x <- show n]

-- (numerosDeFactorizacion n) es el conjunto de los números en la
-- factorización de n. Por ejemplo,
--    numerosDeFactorizacion 60  ==  [1,2,3,5]
numerosDeFactorizacion :: Integer -> [Integer]
numerosDeFactorizacion n = 
   sort (nub (aux (factorizacion n)))
   where aux [] = []
         aux ((x,y):zs) = x : y : aux zs

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

-- (factorizacion' n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion' :: Integer -> [Integer]
factorizacion' n | n == 1    = []
                 | otherwise = x : factorizacion' (div n x)
                 where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
menorFactor :: Integer -> Integer
menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 5  ==  120
factorial :: Integer -> Integer
factorial n = product [1..n]

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

digitosDeFactorizacion2 :: Integer -> [Integer]
digitosDeFactorizacion2 n =
   sort (nub (concat [digitos x | x <- numerosDeFactorizacion2 n]))

-- (numerosDeFactorizacion2 n) es el conjunto de los números en la
-- factorización de n. Por ejemplo,
--    numerosDeFactorizacion2 60  ==  [1,2,3,5]
numerosDeFactorizacion2 :: Integer -> [Integer]
numerosDeFactorizacion2 n = 
    sort (nub (aux (factorizacion2 n)))
    where aux xs = concat [[a,b] | (a,b) <- xs]

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

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

digitosDeFactorizacion3 :: Integer -> [Integer]
digitosDeFactorizacion3 n =
    sort (nub (concat [digitos x | x <- aux (group (primeFactors n))]))
    where aux  []            = []
          aux (ys@(y:_):xss) = y : genericLength ys : aux xss

-- Definición
-- ==========

digitosDeFactorizacion :: Integer -> [Integer]
digitosDeFactorizacion = digitosDeFactorizacion3

-- Solución
-- ========

-- Para calcular la solución, se define la constante
solucion :: Integer
solucion = 
    head [n | n <- [1..], digitosDeFactorizacion (factorial n) == [0..9]]

-- El cálculo de la solución es
--    ghci> solucion2
--    49

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

-- La propiedad es
prop_completa :: Integer -> Bool
prop_completa n =
    digitosDeFactorizacion (factorial n1) == [0..9]
    where n1 = 101 + abs n

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

100

101

102

103

104

105

106

107

108

109

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

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª definición

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

digitosDeFactorizacion1 :: Integer -> [Integer]

digitosDeFactorizacion1 n =

sort (nub (concat [digitos x | x <- numerosDeFactorizacion n]))

-- (digitos n) es la lista de los digitos del número n. Por ejemplo,

-- digitos 320274 == [3,2,0,2,7,4]

digitos :: Integer -> [Integer]

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

-- (numerosDeFactorizacion n) es el conjunto de los números en la

-- factorización de n. Por ejemplo,

-- numerosDeFactorizacion 60 == [1,2,3,5]

numerosDeFactorizacion :: Integer -> [Integer]

numerosDeFactorizacion n =

sort (nub (aux (factorizacion n)))

where aux [] = []

aux ((x,y):zs) = x : y : aux zs

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

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

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

factorizacion n =

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

-- (factorizacion' n) es la lista de todos los factores primos de n; es

-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,

-- factorizacion 300 == [2,2,3,5,5]

factorizacion' :: Integer -> [Integer]

factorizacion' n | n == 1 = []

| otherwise = x : factorizacion' (div n x)

where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,

-- menorFactor 15 == 3

menorFactor :: Integer -> Integer

menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 5 == 120

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª definición

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

digitosDeFactorizacion2 :: Integer -> [Integer]

digitosDeFactorizacion2 n =

sort (nub (concat [digitos x | x <- numerosDeFactorizacion2 n]))

-- (numerosDeFactorizacion2 n) es el conjunto de los números en la

-- factorización de n. Por ejemplo,

-- numerosDeFactorizacion2 60 == [1,2,3,5]

numerosDeFactorizacion2 :: Integer -> [Integer]

numerosDeFactorizacion2 n =

sort (nub (aux (factorizacion2 n)))

where aux xs = concat [[a,b] | (a,b) <- xs]

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

-- factorizacion2 300 == [(2,2),(3,1),(5,2)]

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

factorizacion2 n =

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

-- 3ª definición

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

digitosDeFactorizacion3 :: Integer -> [Integer]

digitosDeFactorizacion3 n =

sort (nub (concat [digitos x | x <- aux (group (primeFactors n))]))

where aux [] = []

aux (ys@(y:_):xss) = y : genericLength ys : aux xss

-- Definición

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

digitosDeFactorizacion :: Integer -> [Integer]

digitosDeFactorizacion = digitosDeFactorizacion3

-- Solución

-- ========

-- Para calcular la solución, se define la constante

solucion :: Integer

solucion =

head [n | n <- [1..], digitosDeFactorizacion (factorial n) == [0..9]]

-- El cálculo de la solución es

-- ghci> solucion2

-- 49

-- Propiedad

-- =========

-- La propiedad es

prop_completa :: Integer -> Bool

prop_completa n =

digitosDeFactorizacion (factorial n1) == [0..9]

where n1 = 101 + abs n

-- La comprobación es

-- λ> quickCheck prop_completa

-- +++ OK, passed 100 tests.

La solución en Maxima

/* digitos(n) es la lista de los digitos del número n. Por ejemplo, 
      digitos (320274) == [3,2,0,2,7,4]
*/      
digitos (n) := charlist (string (n))$

digitosDeFactorizacion (n) :=
   unique (apply (append, map (digitos, apply (append, ifactors (n))))) $

solucion () := block ([n:1],
  while length (digitosDeFactorizacion (n!)) < 10 do
     n : n+1,
  n)$   

/*
   (%i5) digitosDeFactorizacion (6!);
   (%o5) [1, 2, 3, 4, 5]

   (%i6) solucion ();
   (%o6) 49
*/

/* digitos(n) es la lista de los digitos del número n. Por ejemplo,

digitos (320274) == [3,2,0,2,7,4]

digitos (n) := charlist (string (n))$

digitosDeFactorizacion (n) :=

unique (apply (append, map (digitos, apply (append, ifactors (n))))) $

solucion () := block ([n:1],

while length (digitosDeFactorizacion (n!)) < 10 do

n : n+1,

n)$

(%i5) digitosDeFactorizacion (6!);

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

(%i6) solucion ();

(%o6) 49

Cantidad de números Pentanacci impares

PorJosé A. Alonso 18-febrero-20162-mayo-2016

Los números de Pentanacci se definen mediante las ecuaciones

   P(0) = 0
   P(1) = 1
   P(2) = 1
   P(3) = 2
   P(4) = 4
   P(n) = P(n-1) + P(n-2) + P(n-3) + P(n-4) + P(n-5), si n > 4

P(0) = 0

P(1) = 1

P(2) = 1

P(3) = 2

P(4) = 4

P(n) = P(n-1) + P(n-2) + P(n-3) + P(n-4) + P(n-5), si n > 4

Los primeros números de Pentanacci son

  0, 1, 1, 2, 4, 8, 16, 31, 61, 120, 236, 464, 912, 1793, 3525, ...

1	0, 1, 1, 2, 4, 8, 16, 31, 61, 120, 236, 464, 912, 1793, 3525, ...

Se obseeva que

hasta P(5) hay 1 impar: el 1 (aunque aparece dos veces);
hasta P(7) hay 2 impares distintos: 1 y 31;
hasta P(10) hay 3 impares distintos: 1, 31 y 61;
hasta P(15) hay 5 impares distintos: 1, 31 y 61, 1793 y 3525.

Definir la función

   nPentanacciImpares :: Integer -> Integer

1	nPentanacciImpares :: Integer -> Integer

tal que (nPentanacciImpares n) es la cantidad de números impares distintos desde P(0) hasta P(n). Por ejemplo,

   nPentanacciImpares 5                             ==  1
   nPentanacciImpares 7                             ==  2
   nPentanacciImpares 10                            ==  3
   nPentanacciImpares 15                            ==  5
   nPentanacciImpares 100                           ==  33
   nPentanacciImpares 1000                          ==  333
   nPentanacciImpares 10000                         ==  3333
   nPentanacciImpares (10^(10^6)) `mod` (10^9)      ==  333333333
   length (show (nPentanacciImpares2 (10^(10^6))))  ==  1000000

nPentanacciImpares 5 == 1

nPentanacciImpares 7 == 2

nPentanacciImpares 10 == 3

nPentanacciImpares 15 == 5

nPentanacciImpares 100 == 33

nPentanacciImpares 1000 == 333

nPentanacciImpares 10000 == 3333

nPentanacciImpares (10^(10^6)) `mod` (10^9) == 333333333

length (show (nPentanacciImpares2 (10^(10^6)))) == 1000000

Soluciones

import Data.List (genericLength, genericTake)

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

nPentanacciImpares1 :: Integer -> Integer
nPentanacciImpares1 0 = 0
nPentanacciImpares1 1 = 1
nPentanacciImpares1 n = 
    genericLength (filter odd (genericTake (n+1) pentanacci)) - 1

pentanacci :: [Integer]
pentanacci = p (0, 1, 1, 2, 4)
    where p (a, b, c, d, e) = a : p (b, c, d, e, a + b + c + d + e)

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

-- λ> map nPentanacciImpares1 [1..31]
-- [1,1,1,1,1,1,2,3,3,3,3,3,4,5,5,5,5,5,6,7,7,7,7,7,8,9,9,9,9,9,10]
-- λ> [(head xs, length xs) | xs <- group (map nPentanacciImpares1 [1..37])]
-- [(1,6),(2,1),(3,5),(4,1),(5,5),(6,1),(7,5),(8,1),(9,5),(10,1),(11,5),(12,1)]

nPentanacciImpares2 :: Integer -> Integer
nPentanacciImpares2 0 = 0
nPentanacciImpares2 1 = 1
nPentanacciImpares2 n = 2 * q + min r 2 - 1
    where (q,r) = n `quotRem` 6

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

nPentanacciImpares3 :: Integer -> Integer
nPentanacciImpares3 0 = 0
nPentanacciImpares3 1 = 1
nPentanacciImpares3 n | r == 5    = 2*q + 2 
                      | otherwise = 2*q + 1 
    where (q,r) = divMod (n-2) 6

import Data.List (genericLength, genericTake)

-- 1ª definición

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

nPentanacciImpares1 :: Integer -> Integer

nPentanacciImpares1 0 = 0

nPentanacciImpares1 1 = 1

nPentanacciImpares1 n =

genericLength (filter odd (genericTake (n+1) pentanacci)) - 1

pentanacci :: [Integer]

pentanacci = p (0, 1, 1, 2, 4)

where p (a, b, c, d, e) = a : p (b, c, d, e, a + b + c + d + e)

-- 2ª definición

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

-- λ> map nPentanacciImpares1 [1..31]

-- [1,1,1,1,1,1,2,3,3,3,3,3,4,5,5,5,5,5,6,7,7,7,7,7,8,9,9,9,9,9,10]

-- λ> [(head xs, length xs) | xs <- group (map nPentanacciImpares1 [1..37])]

-- [(1,6),(2,1),(3,5),(4,1),(5,5),(6,1),(7,5),(8,1),(9,5),(10,1),(11,5),(12,1)]

nPentanacciImpares2 :: Integer -> Integer

nPentanacciImpares2 0 = 0

nPentanacciImpares2 1 = 1

nPentanacciImpares2 n = 2 * q + min r 2 - 1

where (q,r) = n `quotRem` 6

-- 3ª definición

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

nPentanacciImpares3 :: Integer -> Integer

nPentanacciImpares3 0 = 0

nPentanacciImpares3 1 = 1

nPentanacciImpares3 n | r == 5 = 2*q + 2

| otherwise = 2*q + 1

where (q,r) = divMod (n-2) 6

Diagonales de matrices como listas

PorJosé A. Alonso 16-febrero-201623-febrero-2016

Las matrices se pueden representar como listas de listas de la misma longitud, donde cada uno de sus elementos representa una fila de la matriz.

Definir la función

   diagonal :: [[a]] -> [a]

1	diagonal :: [[a]] -> [a]

tal que (diagonal xss) es la diagonal de la matriz xss. Por ejemplo,

   diagonal [[3,5,2],[4,7,1],[6,9,0]]           ==  [3,7,0]
   diagonal [[3,5],[4,7],[6,9]]                 ==  [3,7]
   diagonal [[3,5,2],[4,7,1]]                   ==  [3,7]
   sum (diagonal (replicate 20000 [1..20000]))  ==  200010000

diagonal [[3,5,2],[4,7,1],[6,9,0]] == [3,7,0]

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

diagonal [[3,5,2],[4,7,1]] == [3,7]

sum (diagonal (replicate 20000 [1..20000])) == 200010000

Soluciones

import Data.Array  ((!), listArray)
import Data.Matrix (fromLists, getDiag)
import Data.Vector (toList)

-- 1ª definición (por recursión):
diagonal1 :: [[a]] -> [a]
diagonal1 ((x:_):xss) = x : diagonal1 [tail xs | xs <- xss]
diagonal1 _           = []

-- 2ª definición (por comprensión):
diagonal2 :: [[a]] -> [a]
diagonal2 xss = [xs!!k | (xs,k) <- zip xss [0..n]]
    where n = length (head xss) - 1

-- 3ª definición (con Data.Matrix)
diagonal3 :: [[a]] -> [a]
diagonal3 = toList . getDiag . fromLists

-- 4ª definición (con Data.Array)
diagonal4 :: [[a]] -> [a]
diagonal4 xss = [p!(i,i) | i <- [1..k]] 
    where m = length xss
          n = length (head xss)
          k = min m n
          p = listArray ((1,1),(m,n)) (concat xss)

-- Comparación de eficiencia
--    λ> let n = 3000 in sum (diagonal1 (replicate n [1..n]))
--    4501500
--    (2.08 secs, 754,089,992 bytes)
--    λ> let n = 3000 in sum (diagonal2 (replicate n [1..n]))
--    4501500
--    (0.06 secs, 0 bytes)
--    λ> let n = 3000 in sum (diagonal3 (replicate n [1..n]))
--    4501500
--    (1.22 secs, 1,040,787,360 bytes)
--    λ> let n = 3000 in sum (diagonal4 (replicate n [1..n]))
--    4501500
--    (0.96 secs, 624,463,632 bytes)

import Data.Array ((!), listArray)

import Data.Matrix (fromLists, getDiag)

import Data.Vector (toList)

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

diagonal1 :: [[a]] -> [a]

diagonal1 ((x:_):xss) = x : diagonal1 [tail xs | xs <- xss]

diagonal1 _ = []

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

diagonal2 :: [[a]] -> [a]

diagonal2 xss = [xs!!k | (xs,k) <- zip xss [0..n]]

where n = length (head xss) - 1

-- 3ª definición (con Data.Matrix)

diagonal3 :: [[a]] -> [a]

diagonal3 = toList . getDiag . fromLists

-- 4ª definición (con Data.Array)

diagonal4 :: [[a]] -> [a]

diagonal4 xss = [p!(i,i) | i <- [1..k]]

where m = length xss

n = length (head xss)

k = min m n

p = listArray ((1,1),(m,n)) (concat xss)

-- Comparación de eficiencia

-- λ> let n = 3000 in sum (diagonal1 (replicate n [1..n]))

-- 4501500

-- (2.08 secs, 754,089,992 bytes)

-- λ> let n = 3000 in sum (diagonal2 (replicate n [1..n]))

-- 4501500

-- (0.06 secs, 0 bytes)

-- λ> let n = 3000 in sum (diagonal3 (replicate n [1..n]))

-- 4501500

-- (1.22 secs, 1,040,787,360 bytes)

-- λ> let n = 3000 in sum (diagonal4 (replicate n [1..n]))

-- 4501500

-- (0.96 secs, 624,463,632 bytes)

Solución con Maxima

diagonal (xss) := block ([A],
  A : apply (matrix, xss),
  [m,n] : matrix_size (A),
  k : min (m,n),
  makelist (A[i,i],i,k))$

diagonal (xss) := block ([A],

A : apply (matrix, xss),

[m,n] : matrix_size (A),

k : min (m,n),

makelist (A[i,i],i,k))$

Números como suma de N sumandos

PorJosé A. Alonso 15-febrero-201622-febrero-2016

Definir la función

   sumas :: Int -> [Int] -> [Int]

1	sumas :: Int -> [Int] -> [Int]

tal que (sumas n xs) es la lista de los números que se pueden obtener como suma de n, o menos, elementos de xs. Por ejemplo,

   sumas 0 [2,5]              ==  [0]
   sumas 1 [2,5]              ==  [0,2,5]
   sumas 2 [2,5]              ==  [0,2,4,5,7,10]
   sumas 3 [2,5]              ==  [0,2,4,5,6,7,9,10,12,15]
   sumas 2 [2,3,5]            ==  [0,2,3,4,5,6,7,8,10]
   sumas 3 [2,3,5]            ==  [0,2,3,4,5,6,7,8,9,10,11,12,13,15]
   length (sumas 8 [1..200])  ==  1601

sumas 0 [2,5] == [0]

sumas 1 [2,5] == [0,2,5]

sumas 2 [2,5] == [0,2,4,5,7,10]

sumas 3 [2,5] == [0,2,4,5,6,7,9,10,12,15]

sumas 2 [2,3,5] == [0,2,3,4,5,6,7,8,10]

sumas 3 [2,3,5] == [0,2,3,4,5,6,7,8,9,10,11,12,13,15]

length (sumas 8 [1..200]) == 1601

Soluciones

import Data.List (nub, sort)

sumas :: Int -> [Int] -> [Int]
sumas 0 _  = [0]
sumas n xs = nub (sort (ys ++ [x+y | x <- xs, y <- ys]))
    where ys = sumas (n-1) xs

import Data.List (nub, sort)

sumas :: Int -> [Int] -> [Int]

sumas 0 _ = [0]

sumas n xs = nub (sort (ys ++ [x+y | x <- xs, y <- ys]))

where ys = sumas (n-1) xs

Solución con Maxima

sumas (n,xs) := block ([ys],
  if n > 0
  then ( ys : sumas (n-1, xs),
         unique (append (ys, create_list (x+y,x,xs,y,ys))) )
  else [0])$

sumas (n,xs) := block ([ys],

if n > 0

then ( ys : sumas (n-1, xs),

unique (append (ys, create_list (x+y,x,xs,y,ys))) )

else [0])$

Anotación de la profundidad de los nodos

PorJosé A. Alonso 12-febrero-201619-febrero-2016

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

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving (Eq, 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))

Anotando cada elemento del árbol anterior con su profundidad, se obtiene el árbol siguiente

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

3-0

/ \

4-1 7-1

/ \ / \

5-2 0-2 0-2 3-0

/ \

2-3 0-3

Definir la función

   anotado :: Arbol a -> Arbol (a,Int)

1	anotado :: Arbol a -> Arbol (a,Int)

tal que (anotado x) es el árbol obtenido anotando los elementos de x con su profundidad. Por ejemplo,

   λ> anotado ejArbol
   N (3,0) 
     (N (4,1) 
        (N (5,2) (H (2,3)) (H (0,3))) 
        (H (0,2))) 
     (N (7,1) (H (0,2)) (H (3,2)))

λ> anotado ejArbol

N (3,0)

(N (4,1)

(N (5,2) (H (2,3)) (H (0,3)))

(H (0,2)))

(N (7,1) (H (0,2)) (H (3,2)))

Soluciones

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

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

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

anotado1 :: Arbol a -> Arbol (a,Int)
anotado1 (H x)     = H (x,0)
anotado1 (N x i d) = aux (N x i d) 0
    where aux (H x)     n = H (x,n)
          aux (N x i d) n = N (x,n) (aux i (n+1)) (aux d (n+1))  

-- 2ª solución
anotado2 :: Arbol a -> Arbol (a, Int)
anotado2 a = aux a [0..]
    where aux (H a)     (n:_ ) = H (a,n)
          aux (N a i d) (n:ns) = N (a,n) (aux i ns) (aux d ns)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Integer

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

-- 1ª solución

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

anotado1 :: Arbol a -> Arbol (a,Int)

anotado1 (H x) = H (x,0)

anotado1 (N x i d) = aux (N x i d) 0

where aux (H x) n = H (x,n)

aux (N x i d) n = N (x,n) (aux i (n+1)) (aux d (n+1))

-- 2ª solución

anotado2 :: Arbol a -> Arbol (a, Int)

anotado2 a = aux a [0..]

where aux (H a) (n:_ ) = H (a,n)

aux (N a i d) (n:ns) = N (a,n) (aux i ns) (aux d ns)

Compactación de listas

PorJosé A. Alonso 11-febrero-201626-marzo-2022

Definir la función

   compactada :: [Maybe Int] -> [Int]

1	compactada :: [Maybe Int] -> [Int]

tal que (compacta xs) es la lista obtenida al compactar xs con las siguientes reglas:

se eliminan los elementos Nothing;
si dos elementos consecutivos tienen el mismo valor, se sustituyen por el sucesor de su valor y
los restantes elementos no se cambian.

Por ejemplo,

    λ> compactada [Just 1,Nothing,Just 1,Just 4,Just 4,Just 3,Just 6]
    [2,5,3,6]
    λ> compactada [Just 1,Nothing,Just 1,Just 1,Just 4,Just 3,Just 6]
    [2,1,4,3,6]
    λ> compactada [Just 1,Nothing,Just 1,Just 1,Just 4,Just 4,Just 6]
    [2,1,5,6]
    λ> compactada [Just 1,Nothing,Just 1,Just 1,Just 4,Just 3,Just 4]
    [2,1,4,3,4]
    λ> compactada [Just 1,Nothing,Just 1,Just 2,Just 4,Just 3,Just 4]
    [2,2,4,3,4]

λ> compactada [Just 1,Nothing,Just 1,Just 4,Just 4,Just 3,Just 6]

[2,5,3,6]

λ> compactada [Just 1,Nothing,Just 1,Just 1,Just 4,Just 3,Just 6]

[2,1,4,3,6]

λ> compactada [Just 1,Nothing,Just 1,Just 1,Just 4,Just 4,Just 6]

[2,1,5,6]

λ> compactada [Just 1,Nothing,Just 1,Just 1,Just 4,Just 3,Just 4]

[2,1,4,3,4]

λ> compactada [Just 1,Nothing,Just 1,Just 2,Just 4,Just 3,Just 4]

[2,2,4,3,4]

Soluciones

-- 1ª definición
compactada1 :: [Maybe Int] -> [Int]
compactada1 xs = aux (valores xs)
    where aux (x:y:xs) | x == y    = x+1 : aux xs
                       | otherwise = x : aux (y:xs)
          aux xs                   = xs

-- (valores vs) es la lista de los valores de vs. Por ejemplo,
--    ghci> valores [Just 1,Nothing,Just 1,Nothing,Just 3,Just 6]
--    [1,1,3,6]
valores :: [Maybe Int] -> [Int]
valores xs = [x | Just x <- xs]

-- 2ª definición de valores (por recursión):
valores2 :: [Maybe Int] -> [Int]
valores2 []            = []
valores2 ((Just v):vs) = v: valores2 vs
valores2 (Nothing:vs)  = valores2 vs

-- 1ª definición

compactada1 :: [Maybe Int] -> [Int]

compactada1 xs = aux (valores xs)

where aux (x:y:xs) | x == y = x+1 : aux xs

| otherwise = x : aux (y:xs)

aux xs = xs

-- (valores vs) es la lista de los valores de vs. Por ejemplo,

-- ghci> valores [Just 1,Nothing,Just 1,Nothing,Just 3,Just 6]

-- [1,1,3,6]

valores :: [Maybe Int] -> [Int]

valores xs = [x | Just x <- xs]

-- 2ª definición de valores (por recursión):

valores2 :: [Maybe Int] -> [Int]

valores2 [] = []

valores2 ((Just v):vs) = v: valores2 vs

valores2 (Nothing:vs) = valores2 vs

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

Inserciones por posición

PorJosé A. Alonso 25-diciembre-20151-enero-2016

Definir la función

   inserta :: [a] -> [[a]] -> [[a]]

1	inserta :: [a] -> [[a]] -> [[a]]

tal que (inserta xs yss) es la lista obtenida insertando

el primer elemento de xs como primero en la primera lista de yss,
el segundo elemento de xs como segundo en la segunda lista de yss (si la segunda lista de yss tiene al menos un elemento),
el tercer elemento de xs como tercero en la tercera lista de yss (si la tercera lista de yss tiene al menos dos elementos),

y así sucesivamente. Por ejemplo,

   inserta [1,2,3] [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,3,8]]
   inserta [1,2,3] [[4,7],[] ,[9,5,8]]  ==  [[1,4,7],[],   [9,5,3,8]]
   inserta [1,2]   [[4,7],[6],[9,5,8]]  ==  [[1,4,7],[6,2],[9,5,8]]
   inserta [1,2,3] [[4,7],[6]]          ==  [[1,4,7],[6,2]]
   inserta "tad"   ["odo","pra","naa"]  ==  ["todo","para","nada"]

inserta [1,2,3] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,3,8]]

inserta [1,2,3] [[4,7],[] ,[9,5,8]] == [[1,4,7],[], [9,5,3,8]]

inserta [1,2] [[4,7],[6],[9,5,8]] == [[1,4,7],[6,2],[9,5,8]]

inserta [1,2,3] [[4,7],[6]] == [[1,4,7],[6,2]]

inserta "tad" ["odo","pra","naa"] == ["todo","para","nada"]

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

Soluciones

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

inserta :: [a] -> [[a]] -> [[a]]
inserta xs yss = aux xs yss 0 where
    aux [] yss _ = yss
    aux xs []  _ = []
    aux (x:xs) (ys:yss) n 
        | length us == n = (us ++ x : vs) : aux xs yss (n+1)
        | otherwise      = ys : aux xs yss (n+1)
        where (us,vs) = splitAt n ys

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

inserta2 :: [a] -> [[a]] -> [[a]]
inserta2 xs yss =  
    [ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss
 
ins :: Int -> a -> [a] -> [a]
ins n x ys | length ys < n  = ys
           | otherwise      = take n ys ++ x : drop n ys

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

--    λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))
--    10000
--    (3.28 secs, 6,400,568,776 bytes)
--    λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))
--    10000
--    (0.02 secs, 0 bytes)

-- 1ª solución

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

inserta :: [a] -> [[a]] -> [[a]]

inserta xs yss = aux xs yss 0 where

aux [] yss _ = yss

aux xs [] _ = []

aux (x:xs) (ys:yss) n

| length us == n = (us ++ x : vs) : aux xs yss (n+1)

| otherwise = ys : aux xs yss (n+1)

where (us,vs) = splitAt n ys

-- 2ª solución

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

inserta2 :: [a] -> [[a]] -> [[a]]

inserta2 xs yss =

[ins n x ys | (n,x,ys) <- zip3 [0..] xs yss] ++ drop (length xs) yss

ins :: Int -> a -> [a] -> [a]

ins n x ys | length ys < n = ys

| otherwise = take n ys ++ x : drop n ys

-- Comparación de eficiencia

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

-- λ> let n = 10000 in length (inserta [1..n] (replicate n (replicate n 0)))

-- 10000

-- (3.28 secs, 6,400,568,776 bytes)

-- λ> let n = 10000 in length (inserta2 [1..n] (replicate n (replicate n 0)))

-- 10000

-- (0.02 secs, 0 bytes)

Siembra de listas

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

Definir la función

   siembra :: [Int] -> [Int]

1	siembra :: [Int] -> [Int]

tal que (siembra xs) es la lista ys obtenida al repartir cada elemento x de la lista xs poniendo un 1 en las x siguientes posiciones de la lista ys. Por ejemplo,

   siembra [4]      ==  [0,1,1,1,1] 
   siembra [0,2]    ==  [0,0,1,1]
   siembra [4,2]    ==  [0,1,2,2,1]

siembra [4] == [0,1,1,1,1]

siembra [0,2] == [0,0,1,1]

siembra [4,2] == [0,1,2,2,1]

El tercer ejemplo se obtiene sumando la siembra de 4 en la posición 0 (como el ejemplo 1) y el 2 en la posición 1 (como el ejemplo 2). Otros ejemplos son

   siembra [0,4,2]          ==  [0,0,1,2,2,1]
   siembra [3]              ==  [0,1,1,1]
   siembra [3,4,2]          ==  [0,1,2,3,2,1]
   siembra [3,2,1]          ==  [0,1,2,3]
   sum $ siembra [1..2500]  ==  3126250

siembra [0,4,2] == [0,0,1,2,2,1]

siembra [3] == [0,1,1,1]

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

siembra [3,2,1] == [0,1,2,3]

sum $ siembra [1..2500] == 3126250

Comprobar con QuickCheck que la suma de los elementos de (siembra xs) es igual que la suma de los de xs.

Nota 1: Se supone que el argumento es una lista de números no negativos y que se puede ampliar tanto como sea necesario para repartir los elementos.

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

Soluciones

import Test.QuickCheck

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

siembra1 :: [Int] -> [Int]
siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los
-- elementos de xs. Por ejemplo,
--    brotes [3,4,2]  ==  [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]
brotes :: [Int] -> [[Int]]
brotes xs = aux xs 1
    where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)
          aux _ _      = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al
-- final de cada elemento se continua con ceros). Por ejemplo,
--    suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]  ==  [0,1,2,3,2,1]
suma :: [[Int]] -> [Int]
suma = foldr1 aux
    where aux [] ys = ys
          aux xs [] = xs
          aux (x:xs) (y:ys) = (x+y) : aux xs ys

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

siembra2 :: [Int] -> [Int]
siembra2 [] = []
siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]
siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]
mezcla xs ys =
    take (max (length xs) (length ys))
         (zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

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

siembra3 :: [Int] -> [Int]
siembra3 [] = []
siembra3 xs = aux xs 0 (repeat 0) where
    aux []     _ ys = cosecha ys
    aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys) 
        where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los
-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,
--    cosecha [0,0,3,5,2,0,9]            ==  [0,0,3,5,2]
--    cosecha ([0,0,3,5,2] ++ repeat 0)  ==  [0,0,3,5,2]
cosecha :: [Int] -> [Int]              
cosecha xs = ys ++ takeWhile (>0) zs
    where (ys,zs) = span (==0) xs

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

siembra4 :: [Int] -> [Int]
siembra4 [] = []
siembra4 xs = aux xs [] (repeat 0) where
    aux []     ys zs     = reverse ys ++ takeWhile (>0) zs
    aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs) 
        where brotes = replicate x 1 ++ repeat 0

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

--    λ> sum $ siembra1 [1..2000]
--    2001000
--    (9.44 secs, 1,894,065,928 bytes)
--    ghci> sum $ siembra2 [1..2000]
--    2001000
--    (5.92 secs, 936900576 bytes)
--    ghci> sum $ siembra3 [1..2000]
--    2001000
--    (1.59 secs, 836847072 bytes)
--    ghci> sum $ siembra4 [1..2000]
--    2001000
--    (1.68 secs, 570492392 bytes)

-- En lo que sigue usaremos la 2ª definición
siembra :: [Int] -> [Int]
siembra = siembra2

-- Verificación
-- ============

-- La propiedad es
prop_siembra :: [Int] -> Bool
prop_siembra xs =
    sum (siembra1 ys) == sum ys
    where ys = map (\x -> 1 + abs x) xs

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

100

import Test.QuickCheck

-- 1ª solución

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

siembra1 :: [Int] -> [Int]

siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los

-- elementos de xs. Por ejemplo,

-- brotes [3,4,2] == [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]

brotes :: [Int] -> [[Int]]

brotes xs = aux xs 1

where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)

aux _ _ = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al

-- final de cada elemento se continua con ceros). Por ejemplo,

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

suma :: [[Int]] -> [Int]

suma = foldr1 aux

where aux [] ys = ys

aux xs [] = xs

aux (x:xs) (y:ys) = (x+y) : aux xs ys

-- 2ª solución

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

siembra2 :: [Int] -> [Int]

siembra2 [] = []

siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]

siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]

mezcla xs ys =

take (max (length xs) (length ys))

(zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

-- 3ª solución

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

siembra3 :: [Int] -> [Int]

siembra3 [] = []

siembra3 xs = aux xs 0 (repeat 0) where

aux [] _ ys = cosecha ys

aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys)

where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los

-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,

-- cosecha [0,0,3,5,2,0,9] == [0,0,3,5,2]

-- cosecha ([0,0,3,5,2] ++ repeat 0) == [0,0,3,5,2]

cosecha :: [Int] -> [Int]

cosecha xs = ys ++ takeWhile (>0) zs

where (ys,zs) = span (==0) xs

-- 4ª solución

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

siembra4 :: [Int] -> [Int]

siembra4 [] = []

siembra4 xs = aux xs [] (repeat 0) where

aux [] ys zs = reverse ys ++ takeWhile (>0) zs

aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs)

where brotes = replicate x 1 ++ repeat 0

-- Comparación de eficiencia

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

-- λ> sum $ siembra1 [1..2000]

-- 2001000

-- (9.44 secs, 1,894,065,928 bytes)

-- ghci> sum $ siembra2 [1..2000]

-- 2001000

-- (5.92 secs, 936900576 bytes)

-- ghci> sum $ siembra3 [1..2000]

-- 2001000

-- (1.59 secs, 836847072 bytes)

-- ghci> sum $ siembra4 [1..2000]

-- 2001000

-- (1.68 secs, 570492392 bytes)

-- En lo que sigue usaremos la 2ª definición

siembra :: [Int] -> [Int]

siembra = siembra2

-- Verificación

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

-- La propiedad es

prop_siembra :: [Int] -> Bool

prop_siembra xs =

sum (siembra1 ys) == sum ys

where ys = map (\x -> 1 + abs x) xs

-- La comprobación es

-- λ> quickCheck prop_siembra

-- +++ OK, passed 100 tests.

Producto infinito

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

Definir la función

   productoInfinito :: [Int] -> [Int]

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

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

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

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

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

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

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

Soluciones

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

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

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

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

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

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

productoInfinito1 :: [Integer] -> [Integer]

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

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

productoInfinito2 :: [Integer] -> [Integer]

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

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

productoInfinito3 :: [Integer] -> [Integer]

productoInfinito3 [] = [1]

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

-- 4ª definición (con scanl1)

productoInfinito4 :: [Integer] -> [Integer]

productoInfinito4 = scanl1 (*)

-- Comparación de eficiencia

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

-- "11358071114466915693"

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

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

-- "11358071114466915693"

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

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

-- "11358071114466915693"

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

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

-- "11358071114466915693"

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

Listas hermanadas

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

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

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

Definir la función

   hermanada :: [Int] -> Bool

1	hermanada :: [Int] -> Bool

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

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

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

hermanada [2,3,5] == False

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

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

Soluciones

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

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

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

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

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

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

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

hermanada1 :: [Int] -> Bool

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

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

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

hermanos :: (Int, Int) -> Bool

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

-- 2ª definición (con all)

hermanada2 :: [Int] -> Bool

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

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

hermanada3 :: [Int] -> Bool

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

hermanada3 _ = True

-- 4ª definición (por plegado)

hermanada4 :: [Int] -> Bool

hermanada4 xs =

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

-- Comparación de eficiencia

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

-- True

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

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

-- True

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

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

-- True

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

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

-- True

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

Suma de elementos en posiciones dadas

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

Definir la función

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

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

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

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

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

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

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

Soluciones

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

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

-- 1ª solución

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

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

where n = length xs

-- 2ª solución

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

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

where n = length xs

aux _ [] r = r

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

Factorizable respecto de una lista

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

Definir la función

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

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

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

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

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

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

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

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

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

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

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

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

factorizable 12 [5,6] == False

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

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

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

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

Soluciones

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

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

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

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

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

-- 1ª definición

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

factorizable1 1 _ = True

factorizable1 0 ys = 0 `elem` ys

factorizable1 x ys =

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

, y /= 0 && y /= 1

, x `mod` y == 0 ]

-- 2ª definición

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

factorizable2 1 _ = True

factorizable2 0 ys = 0 `elem` ys

factorizable2 x ys =

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

where aux _ [] = False

aux 1 _ = True

aux x ys | null zs = False

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

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

-- 3ª definición

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

factorizable3 1 _ = True

factorizable3 0 ys = 0 `elem` ys

factorizable3 x ys =

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

where aux _ [] = False

aux 1 _ = True

aux x (y:ys)

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

| otherwise = aux x ys

-- Comparación de eficiencia

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

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

-- True

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

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

-- True

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

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

-- True

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

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

-- False

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

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

-- False

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

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

-- False

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

Los números de Smith

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

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

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

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

y el 4937775 también lo es ya que

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

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

Definir las funciones

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

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

tales que

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

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

esSmith 22 == True

esSmith 29 == False

esSmith 2015 == False

esSmith 4937775 == True

esSmith 4567597056 == True

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

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

λ> take 17 smith

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

λ> smith !! 2000

62158

Soluciones

import Data.Numbers.Primes

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

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

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

import Data.Numbers.Primes

esSmith :: Integer -> Bool

esSmith x =

not (isPrime x) &&

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

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

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

smith :: [Integer]

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

Raíces enteras de los números primos

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

Definir la sucesión

   raicesEnterasDePrimos :: [Integer]

1	raicesEnterasDePrimos :: [Integer]

cuyos elementos son las partes enteras de las raíces cuadradas de los números primos. Por ejemplo,

   λ> take 30 raicesEnterasDePrimos
   [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]
   λ> raicesEnterasDePrimos !!  9963
   322
   λ> raicesEnterasDePrimos !!  9964
   323

λ> take 30 raicesEnterasDePrimos

[1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8,8,8,9,9,9,10,10,10,10,10]

λ> raicesEnterasDePrimos !! 9963

322

λ> raicesEnterasDePrimos !! 9964

323

Comprobar con QuickCheck que la diferencia entre dos términos consecutivos de la sucesión es como máximo igual a 1.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck

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

raicesEnterasDePrimos1 :: [Integer]
raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por
-- ejemplo,
--    raizEntera  8  ==  2
--    raizEntera  9  ==  3
--    raizEntera 10  ==  3
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

raicesEnterasDePrimos2 :: [Integer]
raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer
raizEntera2 n = aux 1
    where aux k | k*k > n   = k-1
                | otherwise = aux (k+1)

-- 3º solución
-- ===========

raicesEnterasDePrimos3 :: [Integer]
raicesEnterasDePrimos3 = aux primes [1..]
    where aux (p:ps) (x:xs) | p > x*x   = aux (p:ps) xs
                            | otherwise = (x-1) : aux ps (x:xs)


-- Comparación de eficiencia
--    ghci> raicesEnterasDePrimos1 !! 400000
--    2408
--    (2.86 secs, 1177922500 bytes)
--    ghci> raicesEnterasDePrimos2 !! 400000
--    2408
--    (3.08 secs, 1177432260 bytes)
--    ghci> raicesEnterasDePrimos3 !! 400000
--    2408
--    (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición
raicesEnterasDePrimos :: [Integer]
raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es
prop_raicesEnterasDePrimos :: Int -> Property
prop_raicesEnterasDePrimos n =
    n >= 0 ==> 
    raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

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

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª solución

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

raicesEnterasDePrimos1 :: [Integer]

raicesEnterasDePrimos1 = map raizEntera primes

-- (raizEntera x) es la parte entera de la raíz cuadrada de x. Por

-- ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

raicesEnterasDePrimos2 :: [Integer]

raicesEnterasDePrimos2 = map raizEntera2 primes

raizEntera2 :: Integer -> Integer

raizEntera2 n = aux 1

where aux k | k*k > n = k-1

| otherwise = aux (k+1)

-- 3º solución

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

raicesEnterasDePrimos3 :: [Integer]

raicesEnterasDePrimos3 = aux primes [1..]

where aux (p:ps) (x:xs) | p > x*x = aux (p:ps) xs

| otherwise = (x-1) : aux ps (x:xs)

-- Comparación de eficiencia

-- ghci> raicesEnterasDePrimos1 !! 400000

-- 2408

-- (2.86 secs, 1177922500 bytes)

-- ghci> raicesEnterasDePrimos2 !! 400000

-- 2408

-- (3.08 secs, 1177432260 bytes)

-- ghci> raicesEnterasDePrimos3 !! 400000

-- 2408

-- (3.88 secs, 1260772112 bytes)

-- En lo sucesivo usaremos la 1ª definición

raicesEnterasDePrimos :: [Integer]

raicesEnterasDePrimos = raicesEnterasDePrimos3

-- La propiedad es

prop_raicesEnterasDePrimos :: Int -> Property

prop_raicesEnterasDePrimos n =

n >= 0 ==>

raicesEnterasDePrimos !! (n+1) - raicesEnterasDePrimos !! n <= 1

-- La comprobación es

-- λ> quickCheck prop_raicesEnterasDePrimos

-- +++ OK, passed 100 tests.

Paridad de un árbol

PorJosé A. Alonso 1-diciembre-20158-diciembre-2015

Los árboles binarios con valores en las hojas y en los nodos se definen por

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

        5         
       / \        
      /   \       
     9     7      
    / \   / \     
   1   4 6   8

/ \

9 7

/ \ / \

1 4 6 8

se puede representar por

   N 5 (N 9 (H 1) (H 4)) (N 7 (H 6) (H 8))

1	N 5 (N 9 (H 1) (H 4)) (N 7 (H 6) (H 8))

Decimos que un árbol binario es par si la mayoría de sus valores (en nodos u hojas) son pares e impar en caso contrario.

Para representar la paridad se define el tipo Paridad

   data Paridad = Par | Impar deriving (Eq, Show)

1	data Paridad = Par \| Impar deriving (Eq, Show)

Definir la función

   paridad :: Arbol3 Int -> Paridad

1	paridad :: Arbol3 Int -> Paridad

tal que (paridad a) es la paridad del árbol a. Por ejemplo,

   paridad (N 8 (N 6 (H 3) (H 4)) (H 5))  ==  Par
   paridad (N 8 (N 9 (H 3) (H 4)) (H 5))  ==  Impar

1 2	paridad (N 8 (N 6 (H 3) (H 4)) (H 5)) == Par paridad (N 8 (N 9 (H 3) (H 4)) (H 5)) == Impar

Soluciones

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

data Paridad = Par | Impar deriving (Eq, Show)  
 
paridad :: Arbol Int -> Paridad
paridad a | x > y     = Par 
          | otherwise = Impar
          where (x,y) = paridades a

-- (paridades a) es un par (x,y) donde x es el número de valores pares
-- en el árbol a e i es el número de valores impares en el árbol a. Por
-- ejemplo,  
--    paridades (N (N (H 3) 6 (H 4)) 8 (H 5))  ==  (3,2)
--    paridades (N (N (H 3) 9 (H 4)) 8 (H 5))  ==  (2,3)
paridades :: Arbol Int -> (Int,Int)
paridades (H x) | even x    = (1,0)
                | otherwise = (0,1)
paridades (N x i d) | even x    = (1+a1+a2,b1+b2)
                    | otherwise = (a1+a2,1+b1+b2)
                    where (a1,b1) = paridades i
                          (a2,b2) = paridades d

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

data Paridad = Par | Impar deriving (Eq, Show)

paridad :: Arbol Int -> Paridad

paridad a | x > y = Par

| otherwise = Impar

where (x,y) = paridades a

-- (paridades a) es un par (x,y) donde x es el número de valores pares

-- en el árbol a e i es el número de valores impares en el árbol a. Por

-- ejemplo,

-- paridades (N (N (H 3) 6 (H 4)) 8 (H 5)) == (3,2)

-- paridades (N (N (H 3) 9 (H 4)) 8 (H 5)) == (2,3)

paridades :: Arbol Int -> (Int,Int)

paridades (H x) | even x = (1,0)

| otherwise = (0,1)

paridades (N x i d) | even x = (1+a1+a2,b1+b2)

| otherwise = (a1+a2,1+b1+b2)

where (a1,b1) = paridades i

(a2,b2) = paridades d

Separación y mezcla de listas

PorJosé A. Alonso 30-noviembre-20157-diciembre-2015

Definir las funciones

   separacion :: [a] -> ([a],[a])
   mezcla     :: ([a],[a]) -> [a]

1 2	separacion :: [a] -> ([a],[a]) mezcla :: ([a],[a]) -> [a]

tales que (separacion xs) es el par formado eligiendo alternativamente elementos de xs mientras que mezcla intercala los elementos de las dos listas. Por ejemplo,

   separacion [1..5]                   ==  ([1,3,5],[2,4])
   mezcla ([1,3,5],[2,4])              ==  [1,2,3,4,5]
   separacion "Telescopio"             ==  ("Tlsoi","eecpo")
   mezcla ("Tlsoi","eecpo")            ==  "Telescopio"
   take 5 (fst (separacion [2,4..]))   ==  [2,6,10,14,18]
   take 6 (mezcla ([2,4..],[7,14..]))  ==  [2,7,4,14,6,21]

separacion [1..5] == ([1,3,5],[2,4])

mezcla ([1,3,5],[2,4]) == [1,2,3,4,5]

separacion "Telescopio" == ("Tlsoi","eecpo")

mezcla ("Tlsoi","eecpo") == "Telescopio"

take 5 (fst (separacion [2,4..])) == [2,6,10,14,18]

take 6 (mezcla ([2,4..],[7,14..])) == [2,7,4,14,6,21]

Comprobar con QuickCheck que

   mezcla (separacion xs) == xs

1	mezcla (separacion xs) == xs

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
separacion1 :: [a] -> ([a],[a])
separacion1 []       = ([],  [])
separacion1 [x]      = ([x], [])
separacion1 (x:y:zs) = (x:us,y:vs)
    where (us,vs) = separacion1 zs

-- 2ª definición (por comprensión):
separacion2 :: [a] -> ([a],[a])
separacion2 xs = ([x | (x,n) <- aux, even n], 
                  [x | (x,n) <- aux, odd n])
    where aux = zip xs [0..]                                           

-- 3ª definición 
separacion3 :: [a] -> ([a],[a])
separacion3 []       = ([],[])
separacion3 (x:xs)   = (x:zs, ys)
    where (ys, zs) = separacion3 xs 

-- Comprobación de eficiencia
--    ghci> last (snd (separacion1 [1..10000000]))
--    10000000
--    (10.73 secs, 2,945,794,552 bytes)
--
--    ghci> last (snd (separacion2 [1..10000000]))
--    10000000
--    (16.33 secs, 4,351,366,976 bytes)
--    
--    λ> last (snd (separacion3 [1..10000000]))
--    10000000
--    (15.67 secs, 4,423,573,048 bytes)

mezcla :: ([a],[a]) -> [a]
mezcla ([],ys)     = ys 
mezcla (xs,[])     = xs 
mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es
prop_mezcla_separacion :: [Int] -> Bool
prop_mezcla_separacion xs =
    mezcla (separacion xs) == xs

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

import Test.QuickCheck

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

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

separacion1 [] = ([], [])

separacion1 [x] = ([x], [])

separacion1 (x:y:zs) = (x:us,y:vs)

where (us,vs) = separacion1 zs

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

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

separacion2 xs = ([x | (x,n) <- aux, even n],

[x | (x,n) <- aux, odd n])

where aux = zip xs [0..]

-- 3ª definición

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

separacion3 [] = ([],[])

separacion3 (x:xs) = (x:zs, ys)

where (ys, zs) = separacion3 xs

-- Comprobación de eficiencia

-- ghci> last (snd (separacion1 [1..10000000]))

-- 10000000

-- (10.73 secs, 2,945,794,552 bytes)

-- ghci> last (snd (separacion2 [1..10000000]))

-- 10000000

-- (16.33 secs, 4,351,366,976 bytes)

-- λ> last (snd (separacion3 [1..10000000]))

-- 10000000

-- (15.67 secs, 4,423,573,048 bytes)

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

mezcla ([],ys) = ys

mezcla (xs,[]) = xs

mezcla (x:xs,y:ys) = x : y : mezcla (xs,ys)

-- La propiedad es

prop_mezcla_separacion :: [Int] -> Bool

prop_mezcla_separacion xs =

mezcla (separacion xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_mezcla_separacion

-- +++ OK, passed 100 tests.

Soluciones

Solución en Maxima

Soluciones

Soluciones

Solución en Maxima

Soluciones

Referencias

Soluciones

La solución en Maxima

Soluciones

Soluciones

Solución con Maxima

Soluciones

Solución con Maxima

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico