Exercitium

Partición por longitudes

PorJosé A. Alonso 23-junio-201528-octubre-2015

Definir la función

   particion :: [a] -> [Int] -> [[a]]

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

tal que (particion xs ns) es la partición de xs donde la longitud de cada parte está determinada por los elementos de ns. Por ejemplo,

   particion [1..10] [2,5,0,3]  ==  [[1,2],[3,4,5,6,7],[],[8,9,10]] 
   particion [1..10] [1,4,2,3]  ==  [[1],[2,3,4,5],[6,7],[8,9,10]]

1 2	particion [1..10] [2,5,0,3] == [[1,2],[3,4,5,6,7],[],[8,9,10]] particion [1..10] [1,4,2,3] == [[1],[2,3,4,5],[6,7],[8,9,10]]

Soluciones

particion :: [a] -> [Int] -> [[a]]
particion [] []     = []
particion xs (n:ns) = take n xs : particion (drop n xs) ns

particion :: [a] -> [Int] -> [[a]]

particion [] [] = []

particion xs (n:ns) = take n xs : particion (drop n xs) ns

Máximos de una lista

PorJosé A. Alonso 22-junio-201528-octubre-2015

Definir la función

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

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

tal que (maximos xs) es la lista de los elementos de xs que son mayores que todos sus anteriores. Por ejemplo,

   maximos [1,-3,5,2,3,4,7,6,7]                         ==  [1,5,7]
   maximos "bafcdegag"                                  ==  "bfg"
   maximos (concat (replicate (10^6) "adxbcde")++"yz")  ==  "adxyz"
   length (maximos [1..10^6])                           ==  1000000

maximos [1,-3,5,2,3,4,7,6,7] == [1,5,7]

maximos "bafcdegag" == "bfg"

maximos (concat (replicate (10^6) "adxbcde")++"yz") == "adxyz"

length (maximos [1..10^6]) == 1000000

Soluciones

import Data.List (inits, nub)

-- 1ª definición (por comprensión)
maximos1 :: Ord a => [a] -> [a]
maximos1 xs =
    [x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

-- 2ª definición (por recursión)
maximos2 :: Ord a => [a] -> [a]
maximos2 [] = []
maximos2 (x:xs) = x : maximos2 (filter (>x) xs)

-- 3ª definición (por recursión con acumulador)
maximos3 :: Ord a => [a] -> [a]
maximos3 [] = []
maximos3 (x:xs) = aux xs [x] x
    where aux [] zs _ = reverse zs
          aux (y:ys) zs m | y > m     = aux ys (y:zs) y
                          | otherwise = aux ys zs m 

-- 4ª definición (con scanl1):
maximos4 :: Ord a => [a] -> [a]
maximos4 = nub . scanl1 max 

-- Comparación de eficiencia
--    ghci> maximos1 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (5.82 secs, 2859603952 bytes)
--    ghci> maximos2 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.02 secs, 5879664 bytes)
--    ghci> maximos3 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.03 secs, 4153680 bytes)
--    ghci> maximos4 (concat (replicate (10^3) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.02 secs, 4163296 bytes)
--    
--    ghci> maximos2 (concat (replicate (10^6) "adxbcde") ++ "yz")
--    "adxyz"
--    (3.64 secs, 1314485320 bytes)
--    ghci> maximos3 (concat (replicate (10^6) "adxbcde") ++ "yz")
--    "adxyz"
--    (6.59 secs, 1706434544 bytes)
--    ghci> maximos4 (concat (replicate (10^6) "adxbcde") ++ "yz")
--    "adxyz"
--    (0.89 secs, 1594567000 bytes)
--    
--    ghci> length (maximos2 [1..10^4])
--    10000
--    (17.34 secs, 4302913816 bytes)
--    ghci> length (maximos3 [1..10^4])
--    10000
--    (0.03 secs, 6602488 bytes)
--    ghci> length (maximos4 [1..10^4])
--    10000
--    (1.37 secs, 6820408 bytes)

import Data.List (inits, nub)

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

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

maximos1 xs =

[x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

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

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

maximos2 [] = []

maximos2 (x:xs) = x : maximos2 (filter (>x) xs)

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

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

maximos3 [] = []

maximos3 (x:xs) = aux xs [x] x

where aux [] zs _ = reverse zs

aux (y:ys) zs m | y > m = aux ys (y:zs) y

| otherwise = aux ys zs m

-- 4ª definición (con scanl1):

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

maximos4 = nub . scanl1 max

-- Comparación de eficiencia

-- ghci> maximos1 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (5.82 secs, 2859603952 bytes)

-- ghci> maximos2 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.02 secs, 5879664 bytes)

-- ghci> maximos3 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.03 secs, 4153680 bytes)

-- ghci> maximos4 (concat (replicate (10^3) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.02 secs, 4163296 bytes)

-- ghci> maximos2 (concat (replicate (10^6) "adxbcde") ++ "yz")

-- "adxyz"

-- (3.64 secs, 1314485320 bytes)

-- ghci> maximos3 (concat (replicate (10^6) "adxbcde") ++ "yz")

-- "adxyz"

-- (6.59 secs, 1706434544 bytes)

-- ghci> maximos4 (concat (replicate (10^6) "adxbcde") ++ "yz")

-- "adxyz"

-- (0.89 secs, 1594567000 bytes)

-- ghci> length (maximos2 [1..10^4])

-- 10000

-- (17.34 secs, 4302913816 bytes)

-- ghci> length (maximos3 [1..10^4])

-- 10000

-- (0.03 secs, 6602488 bytes)

-- ghci> length (maximos4 [1..10^4])

-- 10000

-- (1.37 secs, 6820408 bytes)

Menor n tal que el primo n-ésimo cumple una propiedad

PorJosé A. Alonso 18-junio-201528-octubre-2015

Sea p(n) el n-ésimo primo y sea r el resto de dividir (p(n)-1)^n + (p(n)+1)^n por p(n)^2. Por ejemplo,

   si n = 3, entonces p(3) =  5 y r = ( 4^3 +  6^3) mod  (5^2) =   5
   si n = 7, entonces p(7) = 17 y r = (16^7 + 18^7) mod (17^2) = 238

1 2	si n = 3, entonces p(3) = 5 y r = ( 4^3 + 6^3) mod (5^2) = 5 si n = 7, entonces p(7) = 17 y r = (16^7 + 18^7) mod (17^2) = 238

Definir la función

   menorPR :: Integer -> Integer

1	menorPR :: Integer -> Integer

tal que (menorPR x) es el menor n tal que el resto de dividir (p(n)-1)^n + (p(n)+1)^n por p(n)^2 es mayor que x. Por ejemplo,

   menorPR 100     == 5
   menorPR 345     == 9
   menorPR 1000    == 13
   menorPR (10^9)  == 7037
   menorPR (10^10) == 21035
   menorPR (10^12) == 191041

menorPR 100 == 5

menorPR 345 == 9

menorPR 1000 == 13

menorPR (10^9) == 7037

menorPR (10^10) == 21035

menorPR (10^12) == 191041

Soluciones

import Data.Numbers.Primes (primes)

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

menorPR1 :: Integer -> Integer
menorPR1 x = head [n | (n,p) <- zip [1..] primes
                     , (((p-1)^n + (p+1)^n) `mod` (p^2)) > x]

-- Segunda solución (usando el binomio de Newton)
-- ==============================================

-- Desarrollando por el binomio de Newton
--    (p+1)^n = C(n,0)p^n + C(n,1)p^(n-1) +...+ C(n,n-1)p + 1
--    (p-1)^n = C(n,0)p^n - C(n,1)p^(n-1) +...+ C(n,n-1)p + (-1)^n
-- Sumando se obtiene (según n sea par o impar)
--    2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,2)p^2 + 2
--    2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,1)p^1
-- Al dividir por p^2, el resto es (según n sea par o impar) 2 ó 2*C(n,1)p

-- (restoM n p) es el resto de de dividir (p-1)^n + (p+1)^n por p^2.
restoM :: Integer -> Integer -> Integer
restoM n p | even n    = 2
           | otherwise = 2*n*p `mod`(p^2)

menorPR2 :: Integer -> Integer
menorPR2 x = head [n | (n,p) <- zip [1..] primes, restoM n p > x]

-- Comparación de eficiencia
--    ghci> menorPR1 (3*10^8)
--    3987
--    (2.44 secs, 120291676 bytes)
--    ghci> menorPR2 (3*10^8)
--    3987
--    (0.04 secs, 8073900 bytes)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

menorPR1 :: Integer -> Integer

menorPR1 x = head [n | (n,p) <- zip [1..] primes

, (((p-1)^n + (p+1)^n) `mod` (p^2)) > x]

-- Segunda solución (usando el binomio de Newton)

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

-- Desarrollando por el binomio de Newton

-- (p+1)^n = C(n,0)p^n + C(n,1)p^(n-1) +...+ C(n,n-1)p + 1

-- (p-1)^n = C(n,0)p^n - C(n,1)p^(n-1) +...+ C(n,n-1)p + (-1)^n

-- Sumando se obtiene (según n sea par o impar)

-- 2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,2)p^2 + 2

-- 2*C(n,0)p^n + 2*C(n,n-2)p^(n-1) +...+ 2*C(n,1)p^1

-- Al dividir por p^2, el resto es (según n sea par o impar) 2 ó 2*C(n,1)p

-- (restoM n p) es el resto de de dividir (p-1)^n + (p+1)^n por p^2.

restoM :: Integer -> Integer -> Integer

restoM n p | even n = 2

| otherwise = 2*n*p `mod`(p^2)

menorPR2 :: Integer -> Integer

menorPR2 x = head [n | (n,p) <- zip [1..] primes, restoM n p > x]

-- Comparación de eficiencia

-- ghci> menorPR1 (3*10^8)

-- 3987

-- (2.44 secs, 120291676 bytes)

-- ghci> menorPR2 (3*10^8)

-- 3987

-- (0.04 secs, 8073900 bytes)

Polinomio cromático de un grafo

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

El polinomio cromático de un grafo calcula el número de maneras en las cuales puede ser coloreado el grafo usando un número de colores dado, de forma que dos vértices adyacentes no tengan el mismo color.

En el caso del grafo completo de n vértices, su polinomio cromático es

   P(n,x) = x(x-1)(x-2) ... (x-(n-1))

1	P(n,x) = x(x-1)(x-2) ... (x-(n-1))

Por ejemplo,

   P(3,x) = x(x-1)(x-2)      = x^3 - 3*x^2 + 2*x
   P(4,x) = x(x-1)(x-2)(x-3) = x^4 - 6*x^3 + 11*x^2 - 6*x

1 2	P(3,x) = x(x-1)(x-2) = x^3 - 3x^2 + 2x P(4,x) = x(x-1)(x-2)(x-3) = x^4 - 6x^3 + 11x^2 - 6*x

Lo que significa que P(4)(x) es el número de formas de colorear el grafo completo de 4 vértices con x colores. Por tanto,

   P(4,2) =  0 (no se puede colorear con 2 colores)
   P(4,4) = 24 (hay 24 formas de colorearlo con 4 colores)

1 2	P(4,2) = 0 (no se puede colorear con 2 colores) P(4,4) = 24 (hay 24 formas de colorearlo con 4 colores)

Definir la función

   polGC:: Int -> Polinomio Int

1	polGC:: Int -> Polinomio Int

tal que (polGC n) es el polinomio cromático del grafo completo de n vértices. Por ejemplo,

   polGC 4  ==  x^4 + -6*x^3 + 11*x^2 + -6*x
   polGC 5  ==  x^5 + -10*x^4 + 35*x^3 + -50*x^2 + 24*x

1 2	polGC 4 == x^4 + -6x^3 + 11x^2 + -6x polGC 5 == x^5 + -10x^4 + 35x^3 + -50x^2 + 24*x

Comprobar con QuickCheck que si el número de colores (x) coincide con el número de vértices del grafo (n), el número de maneras de colorear el grafo es n!.

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

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

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

Nota 2: Este ejercicio debe realizarse usando únicamente las funciones de la librería de polinomios (I1M.PolOperaciones) que se describe aquí y se encuentra aquí.

Soluciones

import I1M.PolOperaciones
import Test.QuickCheck

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

polGC :: Int -> Polinomio Int
polGC 0 = consPol 0 1 polCero
polGC n = polGC (n-1) `multPol` consPol 1 1 (consPol 0 (-n+1) polCero)

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

polGC2 :: Int -> Polinomio Int
polGC2 n = multLista (map polMon [0..n-1])

-- (polMon n) es el monomio x-n. Por ejemplo,
--    polMon 3  ==  1*x + -3
polMon:: Int -> Polinomio Int
polMon n = consPol 1 1 (consPol 0 (-n) polCero)

-- (multLista ps) es el producto de la lista de polinomios ps.
multLista :: [Polinomio Int] -> Polinomio Int
multLista []     = polUnidad
multLista (p:ps) = multPol p (multLista ps)

-- 3ª solución (por plegado)
-- =========================

polGC3 :: Int -> Polinomio Int
polGC3 n = foldl multPol polUnidad
           [consPol 1 1 (consPol 0 (-i) polCero) | i <- [0..n-1]]

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

-- La propiedad es
prop_polGC :: Int -> Property
prop_polGC n = 
    n > 0 ==> valor (polGC n) n == product [1..n]

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_polGC
--    +++ OK, passed 100 tests.
--    (0.04 secs, 7785800 bytes)

import I1M.PolOperaciones

import Test.QuickCheck

-- 1ª solución

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

polGC :: Int -> Polinomio Int

polGC 0 = consPol 0 1 polCero

polGC n = polGC (n-1) `multPol` consPol 1 1 (consPol 0 (-n+1) polCero)

-- 2ª solución

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

polGC2 :: Int -> Polinomio Int

polGC2 n = multLista (map polMon [0..n-1])

-- (polMon n) es el monomio x-n. Por ejemplo,

-- polMon 3 == 1*x + -3

polMon:: Int -> Polinomio Int

polMon n = consPol 1 1 (consPol 0 (-n) polCero)

-- (multLista ps) es el producto de la lista de polinomios ps.

multLista :: [Polinomio Int] -> Polinomio Int

multLista [] = polUnidad

multLista (p:ps) = multPol p (multLista ps)

-- 3ª solución (por plegado)

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

polGC3 :: Int -> Polinomio Int

polGC3 n = foldl multPol polUnidad

[consPol 1 1 (consPol 0 (-i) polCero) | i <- [0..n-1]]

-- Comprobación

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

-- La propiedad es

prop_polGC :: Int -> Property

prop_polGC n =

n > 0 ==> valor (polGC n) n == product [1..n]

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_polGC

-- +++ OK, passed 100 tests.

-- (0.04 secs, 7785800 bytes)

Suma de posteriores

PorJosé A. Alonso 16-junio-201528-octubre-2015

Definir la función

   sumaPosteriores :: [Int] -> [Int]

1	sumaPosteriores :: [Int] -> [Int]

tal que (sumaPosteriores xs) es la lista obtenida sustituyendo cada elemento de xs por la suma de los elementos posteriores. Por ejemplo,

   sumaPosteriores [1..8]        == [35,33,30,26,21,15,8,0]
   sumaPosteriores [1,-3,2,5,-8] == [-4,-1,-3,-8,0]

1 2	sumaPosteriores [1..8] == [35,33,30,26,21,15,8,0] sumaPosteriores [1,-3,2,5,-8] == [-4,-1,-3,-8,0]

Comprobar con QuickCheck que el último elemento de la lista (sumaPosteriores xs) siempre es 0.

Soluciones

import Data.List (tails)
import Test.QuickCheck

-- 1ª definición (por recursión):
sumaPosteriores1 :: [Int] -> [Int]
sumaPosteriores1 []     = []
sumaPosteriores1 (x:xs) = sum xs : sumaPosteriores1 xs

-- 2ª definición (sin argumentos)
sumaPosteriores2 :: [Int] -> [Int]
sumaPosteriores2 = map (sum . tail) . init . tails

-- La propiedad es
propSumaP:: [Int] -> Property
propSumaP xs = not (null xs) ==> last (sumaPosteriores1 xs) == 0

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

import Data.List (tails)

import Test.QuickCheck

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

sumaPosteriores1 :: [Int] -> [Int]

sumaPosteriores1 [] = []

sumaPosteriores1 (x:xs) = sum xs : sumaPosteriores1 xs

-- 2ª definición (sin argumentos)

sumaPosteriores2 :: [Int] -> [Int]

sumaPosteriores2 = map (sum . tail) . init . tails

-- La propiedad es

propSumaP:: [Int] -> Property

propSumaP xs = not (null xs) ==> last (sumaPosteriores1 xs) == 0

-- La comprobación es

-- ghci> quickCheck propSumaP

-- +++ OK, passed 100 tests.

Partición por longitudes

Soluciones

Máximos de una lista

Soluciones

Menor n tal que el primo n-ésimo cumple una propiedad

Soluciones

Polinomio cromático de un grafo

Soluciones

Suma de posteriores

Soluciones

Entradas recientes

Buscar

Correo electrónico