PFH: La semana en Exercitium (9 de julio de 2022)

Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:

1. Ceros finales del factorial
2. Unión e intersección general de conjuntos
3. Intersecciones parciales
4. Mayor semiprimo menor que n
5. Particiones en k subconjuntos

A continuación se muestran las soluciones.

1. Ceros finales del factorial

Definir la función

   cerosDelFactorial :: Integer -> Integer

1	cerosDelFactorial :: Integer -> Integer

tal que (cerosDelFactorial n) es el número de ceros en que termina el factorial de n. Por ejemplo,

   cerosDelFactorial 24                         == 4
   cerosDelFactorial 25                         == 6
   length (show (cerosDelFactorial (10^70000))) == 70000

cerosDelFactorial 24 == 4

cerosDelFactorial 25 == 6

length (show (cerosDelFactorial (10^70000))) == 70000

Soluciones

import Data.List (genericLength)
import Test.QuickCheck (Positive (Positive), quickCheck)

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

cerosDelFactorial1 :: Integer -> Integer
cerosDelFactorial1 n = ceros (factorial n)

-- (factorial n) es el factorial n. Por ejemplo,
--    factorial 3  ==  6
factorial :: Integer -> Integer
factorial n = product [1..n]

-- (ceros n) es el número de ceros en los que termina el número n. Por
-- ejemplo, 
--    ceros 320000  ==  4
ceros :: Integer -> Integer
ceros n | rem n 10 /= 0 = 0
        | otherwise     = 1 + ceros (div n 10)

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

cerosDelFactorial2 :: Integer -> Integer
cerosDelFactorial2 = ceros2 . factorial 

ceros2 :: Integer -> Integer
ceros2 n = genericLength (takeWhile (=='0') (reverse (show n)))

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

cerosDelFactorial3 :: Integer -> Integer
cerosDelFactorial3 n
  | n < 5     = 0
  | otherwise = m + cerosDelFactorial3 m
  where m = n `div` 5

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_cerosDelFactorial :: Positive Integer -> Bool
prop_cerosDelFactorial (Positive n) =
  all (== cerosDelFactorial1 n)
      [cerosDelFactorial2 n,
       cerosDelFactorial3 n]

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

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

-- La comparación es
--    λ> cerosDelFactorial1 (4*10^4)
--    9998
--    (1.93 secs, 2,296,317,904 bytes)
--    λ> cerosDelFactorial2 (4*10^4)
--    9998
--    (1.57 secs, 1,636,242,040 bytes)
--    λ> cerosDelFactorial3 (4*10^4)
--    9998
--    (0.02 secs, 527,584 bytes)

import Data.List (genericLength)

import Test.QuickCheck (Positive (Positive), quickCheck)

-- 1ª solución

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

cerosDelFactorial1 :: Integer -> Integer

cerosDelFactorial1 n = ceros (factorial n)

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

-- factorial 3 == 6

factorial :: Integer -> Integer

factorial n = product [1..n]

-- (ceros n) es el número de ceros en los que termina el número n. Por

-- ejemplo,

-- ceros 320000 == 4

ceros :: Integer -> Integer

ceros n | rem n 10 /= 0 = 0

| otherwise = 1 + ceros (div n 10)

-- 2ª solución

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

cerosDelFactorial2 :: Integer -> Integer

cerosDelFactorial2 = ceros2 . factorial

ceros2 :: Integer -> Integer

ceros2 n = genericLength (takeWhile (=='0') (reverse (show n)))

-- 3ª solución

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

cerosDelFactorial3 :: Integer -> Integer

cerosDelFactorial3 n

| n < 5 = 0

| otherwise = m + cerosDelFactorial3 m

where m = n `div` 5

-- Comprobación de equivalencia

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

-- La propiedad es

prop_cerosDelFactorial :: Positive Integer -> Bool

prop_cerosDelFactorial (Positive n) =

all (== cerosDelFactorial1 n)

[cerosDelFactorial2 n,

cerosDelFactorial3 n]

-- La comprobación es

-- λ> quickCheck prop_cerosDelFactorial

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> cerosDelFactorial1 (4*10^4)

-- 9998

-- (1.93 secs, 2,296,317,904 bytes)

-- λ> cerosDelFactorial2 (4*10^4)

-- 9998

-- (1.57 secs, 1,636,242,040 bytes)

-- λ> cerosDelFactorial3 (4*10^4)

-- 9998

-- (0.02 secs, 527,584 bytes)

El código se encuentra en GitHub.

2. Unión e intersección general de conjuntos

Definir las funciones

   unionGeneral        :: Eq a => [[a]] -> [a]
   interseccionGeneral :: Eq a => [[a]] -> [a]

1 2	unionGeneral :: Eq a => [[a]] -> [a] interseccionGeneral :: Eq a => [[a]] -> [a]

tales que

(unionGeneral xs) es la unión de los conjuntos de la lista de conjuntos xs (es decir, el conjunto de los elementos que pertenecen a alguno de los elementos de xs). Por ejemplo,

     unionGeneral []                    ==  []
     unionGeneral [[1]]                 ==  [1]
     unionGeneral [[1],[1,2],[2,3]]     ==  [1,2,3]
     unionGeneral ([[x] | x <- [1..9]]) ==  [1,2,3,4,5,6,7,8,9]

unionGeneral [] == []

unionGeneral [[1]] == [1]

unionGeneral [[1],[1,2],[2,3]] == [1,2,3]

unionGeneral ([[x] | x <- [1..9]]) == [1,2,3,4,5,6,7,8,9]

(interseccionGeneral xs) es la intersección de los conjuntos de la lista de conjuntos xs (es decir, el conjunto de los elementos que pertenecen a todos los elementos de xs). Por ejemplo,

     interseccionGeneral [[1]]                      ==  [1]
     interseccionGeneral [[2],[1,2],[2,3]]          ==  [2]
     interseccionGeneral [[2,7,5],[1,5,2],[5,2,3]]  ==  [2,5]
     interseccionGeneral ([[x] | x <- [1..9]])      ==  []
     interseccionGeneral (replicate (10^6) [1..5])  ==  [1,2,3,4,5]

interseccionGeneral [[1]] == [1]

interseccionGeneral [[2],[1,2],[2,3]] == [2]

interseccionGeneral [[2,7,5],[1,5,2],[5,2,3]] == [2,5]

interseccionGeneral ([[x] | x <- [1..9]]) == []

interseccionGeneral (replicate (10^6) [1..5]) == [1,2,3,4,5]

Soluciones

import Data.List (foldl', foldl1', intersect, nub, union)
import Test.QuickCheck (NonEmptyList (NonEmpty), quickCheck)

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

unionGeneral1 :: Eq a => [[a]] -> [a]
unionGeneral1 []     = []
unionGeneral1 (x:xs) = x `union` unionGeneral1 xs 

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

unionGeneral2 :: Eq a => [[a]] -> [a]
unionGeneral2 = foldr union []

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

unionGeneral3 :: Eq a => [[a]] -> [a]
unionGeneral3 = foldl' union []

-- Comprobación de equivalencia de unionGeneral
-- ============================================

-- La propiedad es
prop_unionGeneral :: [[Int]] -> Bool
prop_unionGeneral xss =
  all (== unionGeneral1 xss')
      [unionGeneral2 xss',
       unionGeneral3 xss']
  where xss' = nub (map nub xss)
  
-- La comprobación es
--    λ> quickCheck prop_unionGeneral
--    +++ OK, passed 100 tests.
--    (0.85 secs, 1,017,807,600 bytes)

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

-- La comparación es
--    λ> length (unionGeneral1 ([[x] | x <- [1..10^3]]))
--    1000
--    (1.56 secs, 107,478,456 bytes)
--    λ> length (unionGeneral2 ([[x] | x <- [1..10^3]]))
--    1000
--    (1.50 secs, 107,406,560 bytes)
--    λ> length (unionGeneral3 ([[x] | x <- [1..10^3]]))
--    1000
--    (0.07 secs, 92,874,024 bytes)

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

interseccionGeneral1 :: Eq a => [[a]] -> [a]
interseccionGeneral1 [x]    = x
interseccionGeneral1 (x:xs) = x `intersect` interseccionGeneral1 xs 

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

interseccionGeneral2 :: Eq a => [[a]] -> [a]
interseccionGeneral2 = foldr1 intersect

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

interseccionGeneral3 :: Eq a => [[a]] -> [a]
interseccionGeneral3 = foldl1' intersect

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_interseccionGeneral :: NonEmptyList [Int] -> Bool
prop_interseccionGeneral (NonEmpty xss) =
  all (== interseccionGeneral1 xss')
      [interseccionGeneral2 xss',
       interseccionGeneral3 xss']
  where xss' = nub (map nub xss)

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

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

-- La comparación es
--    λ> interseccionGeneral1 (replicate (10^6) [1..5])
--    [1,2,3,4,5]
--    (2.02 secs, 1,173,618,400 bytes)
--    λ> interseccionGeneral2 (replicate (10^6) [1..5])
--    [1,2,3,4,5]
--    (1.83 secs, 1,092,120,224 bytes)
--    λ> interseccionGeneral3 (replicate (10^6) [1..5])
--    [1,2,3,4,5]
--    (1.33 secs, 985,896,136 bytes)

import Data.List (foldl', foldl1', intersect, nub, union)

import Test.QuickCheck (NonEmptyList (NonEmpty), quickCheck)

-- 1ª definición de unionGeneral

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

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

unionGeneral1 [] = []

unionGeneral1 (x:xs) = x `union` unionGeneral1 xs

-- 2ª definición de unionGeneral

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

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

unionGeneral2 = foldr union []

-- 3ª definición de unionGeneral

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

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

unionGeneral3 = foldl' union []

-- Comprobación de equivalencia de unionGeneral

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

-- La propiedad es

prop_unionGeneral :: [[Int]] -> Bool

prop_unionGeneral xss =

all (== unionGeneral1 xss')

[unionGeneral2 xss',

unionGeneral3 xss']

where xss' = nub (map nub xss)

-- La comprobación es

-- λ> quickCheck prop_unionGeneral

-- +++ OK, passed 100 tests.

-- (0.85 secs, 1,017,807,600 bytes)

-- Comparación de eficiencia de unionGeneral

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

-- La comparación es

-- λ> length (unionGeneral1 ([[x] | x <- [1..10^3]]))

-- 1000

-- (1.56 secs, 107,478,456 bytes)

-- λ> length (unionGeneral2 ([[x] | x <- [1..10^3]]))

-- 1000

-- (1.50 secs, 107,406,560 bytes)

-- λ> length (unionGeneral3 ([[x] | x <- [1..10^3]]))

-- 1000

-- (0.07 secs, 92,874,024 bytes)

-- 1ª definición de interseccionGeneral

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

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

interseccionGeneral1 [x] = x

interseccionGeneral1 (x:xs) = x `intersect` interseccionGeneral1 xs

-- 2ª definición de interseccionGeneral

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

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

interseccionGeneral2 = foldr1 intersect

-- 3ª definición de interseccionGeneral

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

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

interseccionGeneral3 = foldl1' intersect

-- Comprobación de equivalencia

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

-- La propiedad es

prop_interseccionGeneral :: NonEmptyList [Int] -> Bool

prop_interseccionGeneral (NonEmpty xss) =

all (== interseccionGeneral1 xss')

[interseccionGeneral2 xss',

interseccionGeneral3 xss']

where xss' = nub (map nub xss)

-- La comprobación es

-- λ> quickCheck prop_interseccionGeneral

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> interseccionGeneral1 (replicate (10^6) [1..5])

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

-- (2.02 secs, 1,173,618,400 bytes)

-- λ> interseccionGeneral2 (replicate (10^6) [1..5])

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

-- (1.83 secs, 1,092,120,224 bytes)

-- λ> interseccionGeneral3 (replicate (10^6) [1..5])

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

-- (1.33 secs, 985,896,136 bytes)

El código se encuentra en GitHub.

3. Intersecciones parciales

Definir la función

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

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

tal que (interseccionParcial n xss) es la lista de los elementos que pertenecen al menos a n conjuntos de xss. Por ejemplo,

   interseccionParcial 1 [[3,4],[4,5,9],[5,4,7]]  == [3,4,5,9,7]
   interseccionParcial 2 [[3,4],[4,5,9],[5,4,7]]  == [4,5]
   interseccionParcial 3 [[3,4],[4,5,9],[5,4,7]]  == [4]
   interseccionParcial 4 [[3,4],[4,5,9],[5,4,7]]  == []

interseccionParcial 1 [[3,4],[4,5,9],[5,4,7]] == [3,4,5,9,7]

interseccionParcial 2 [[3,4],[4,5,9],[5,4,7]] == [4,5]

interseccionParcial 3 [[3,4],[4,5,9],[5,4,7]] == [4]

interseccionParcial 4 [[3,4],[4,5,9],[5,4,7]] == []

Soluciones

import Data.List (foldl', nub, union, sort)
import Test.QuickCheck

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

interseccionParcial1 :: Ord a => Int -> [[a]] -> [a]
interseccionParcial1 n xss = 
  [x | x <- sort (elementos xss)
     , pertenecenAlMenos n xss x]

elementos :: Ord a => [[a]] -> [a]
elementos []       = []
elementos (xs:xss) = xs `union` elementos xss

pertenecenAlMenos :: Ord a => Int -> [[a]] -> a -> Bool
pertenecenAlMenos n xss x =
  length [xs | xs <- xss, x `elem` xs] >= n
  
-- 2ª solución
-- ===========

interseccionParcial2 :: Ord a => Int -> [[a]] -> [a]
interseccionParcial2 n xss = 
  [x | x <- sort (elementos2 xss)
     , pertenecenAlMenos2 n xss x]

elementos2 :: Ord a => [[a]] -> [a]
elementos2 = foldl' union []
  
pertenecenAlMenos2 :: Ord a => Int -> [[a]] -> a -> Bool
pertenecenAlMenos2 n xss x =
  length (filter (x `elem`) xss) >= n
  
-- 3ª solución
-- ===========

interseccionParcial3 :: Ord a => Int -> [[a]] -> [a]
interseccionParcial3 n xss = 
  [x | x <- sort (nub (concat xss))
     , length [xs | xs <- xss, x `elem` xs] >= n]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_interseccionParcial :: Positive Int -> [[Int]] -> Bool
prop_interseccionParcial (Positive n) xss =
  all (== interseccionParcial1 n yss)
      [interseccionParcial2 n yss,
       interseccionParcial3 n yss]
  where yss = map nub xss

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

import Data.List (foldl', nub, union, sort)

import Test.QuickCheck

-- 1ª solución

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

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

interseccionParcial1 n xss =

[x | x <- sort (elementos xss)

, pertenecenAlMenos n xss x]

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

elementos [] = []

elementos (xs:xss) = xs `union` elementos xss

pertenecenAlMenos :: Ord a => Int -> [[a]] -> a -> Bool

pertenecenAlMenos n xss x =

length [xs | xs <- xss, x `elem` xs] >= n

-- 2ª solución

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

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

interseccionParcial2 n xss =

[x | x <- sort (elementos2 xss)

, pertenecenAlMenos2 n xss x]

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

elementos2 = foldl' union []

pertenecenAlMenos2 :: Ord a => Int -> [[a]] -> a -> Bool

pertenecenAlMenos2 n xss x =

length (filter (x `elem`) xss) >= n

-- 3ª solución

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

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

interseccionParcial3 n xss =

[x | x <- sort (nub (concat xss))

, length [xs | xs <- xss, x `elem` xs] >= n]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_interseccionParcial :: Positive Int -> [[Int]] -> Bool

prop_interseccionParcial (Positive n) xss =

all (== interseccionParcial1 n yss)

[interseccionParcial2 n yss,

interseccionParcial3 n yss]

where yss = map nub xss

-- La comprobación es

-- λ> quickCheck prop_interseccionParcial

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

4. Mayor semiprimo menor que n

Un número semiprimo es un número natural es producto de dos números primos no necesariamente distintos. Por ejemplo, 26 es semiprimo (porque 26 = 2·13) y 49 también lo es (porque 49 = 7·7).

Definir la función

   mayorSemiprimoMenor :: Integer -> Integer

1	mayorSemiprimoMenor :: Integer -> Integer

tal que (mayorSemiprimoMenor n) es el mayor semiprimo menor que n (suponiendo que n > 4). Por ejemplo,

   mayorSemiprimoMenor 27      ==  26
   mayorSemiprimoMenor 50      ==  49
   mayorSemiprimoMenor 49      ==  46
   mayorSemiprimoMenor (10^15) == 999999999999998

mayorSemiprimoMenor 27 == 26

mayorSemiprimoMenor 50 == 49

mayorSemiprimoMenor 49 == 46

mayorSemiprimoMenor (10^15) == 999999999999998

Soluciones

import Data.Numbers.Primes (primeFactors, isPrime, primes)
import Test.QuickCheck

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

mayorSemiprimoMenor1 :: Integer -> Integer
mayorSemiprimoMenor1 n =
  head [x | x <- [n-1,n-2..2], semiPrimo x]

semiPrimo :: Integer -> Bool
semiPrimo n =
  not (null [x | x <- [n,n-1..2], 
                 primo x,
                 n `mod` x == 0,
                 primo (n `div` x)])

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

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

mayorSemiprimoMenor2 :: Integer -> Integer
mayorSemiprimoMenor2 n =
  head [x | x <- [n-1,n-2..2], semiPrimo2 x]

semiPrimo2 :: Integer -> Bool
semiPrimo2 n =
  not (null [x | x <- [n-1,n-2..2], 
                 isPrime x,
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

mayorSemiprimoMenor3 :: Integer -> Integer
mayorSemiprimoMenor3 n =
  head [x | x <- [n-1,n-2..2], semiPrimo3 x]

semiPrimo3 :: Integer -> Bool
semiPrimo3 n =
  not (null [x | x <- reverse (takeWhile (<n) primes),
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

mayorSemiprimoMenor4 :: Integer -> Integer
mayorSemiprimoMenor4 n =
  head [ p | p <- [n-1,n-2..2]
           , (length . primeFactors) p == 2]

-- 5ª solución
-- ===========

mayorSemiprimoMenor5 :: Integer -> Integer
mayorSemiprimoMenor5 n
  | semiPrimo5 (n-1) = n-1
  | otherwise        = mayorSemiprimoMenor5 (n-1)

semiPrimo5 :: Integer -> Bool
semiPrimo5 x = length (primeFactors x) == 2

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_mayorSemiprimoMenor :: Integer -> Property
prop_mayorSemiprimoMenor n =
  n > 4 ==>
  all (== mayorSemiprimoMenor1 n)
      [mayorSemiprimoMenor2 n,
       mayorSemiprimoMenor3 n,
       mayorSemiprimoMenor4 n,
       mayorSemiprimoMenor5 n]

-- La comprobación es
--    λ> quickCheck prop_mayorSemiprimoMenor
--    +++ OK, passed 100 tests; 353 discarded.

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

-- La comparación es
--    λ> mayorSemiprimoMenor1 5000
--    4997
--    (1.92 secs, 945,507,880 bytes)
--    λ> mayorSemiprimoMenor2 5000
--    4997
--    (0.05 secs, 123,031,264 bytes)
--    λ> mayorSemiprimoMenor3 5000
--    4997
--    (0.01 secs, 5,865,120 bytes)
--    λ> mayorSemiprimoMenor4 5000
--    4997
--    (0.00 secs, 593,528 bytes)
--    λ> mayorSemiprimoMenor5 5000
--    4997
--    (0.00 secs, 593,200 bytes)
--
--    λ> mayorSemiprimoMenor3 (3*10^6)
--    2999995
--    (2.34 secs, 6,713,620,000 bytes)
--    λ> mayorSemiprimoMenor4 (2*10^6)
--    1999997
--    (0.01 secs, 728,936 bytes)
--    λ> mayorSemiprimoMenor5 (2*10^6)
--    1999997
--    (0.01 secs, 728,608 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.Numbers.Primes (primeFactors, isPrime, primes)

import Test.QuickCheck

-- 1ª solución

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

mayorSemiprimoMenor1 :: Integer -> Integer

mayorSemiprimoMenor1 n =

head [x | x <- [n-1,n-2..2], semiPrimo x]

semiPrimo :: Integer -> Bool

semiPrimo n =

not (null [x | x <- [n,n-1..2],

primo x,

n `mod` x == 0,

primo (n `div` x)])

primo :: Integer -> Bool

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

-- 2ª solución

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

mayorSemiprimoMenor2 :: Integer -> Integer

mayorSemiprimoMenor2 n =

head [x | x <- [n-1,n-2..2], semiPrimo2 x]

semiPrimo2 :: Integer -> Bool

semiPrimo2 n =

not (null [x | x <- [n-1,n-2..2],

isPrime x,

n `mod` x == 0,

isPrime (n `div` x)])

-- 3ª solución

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

mayorSemiprimoMenor3 :: Integer -> Integer

mayorSemiprimoMenor3 n =

head [x | x <- [n-1,n-2..2], semiPrimo3 x]

semiPrimo3 :: Integer -> Bool

semiPrimo3 n =

not (null [x | x <- reverse (takeWhile (<n) primes),

n `mod` x == 0,

isPrime (n `div` x)])

-- 4ª solución

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

mayorSemiprimoMenor4 :: Integer -> Integer

mayorSemiprimoMenor4 n =

head [ p | p <- [n-1,n-2..2]

, (length . primeFactors) p == 2]

-- 5ª solución

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

mayorSemiprimoMenor5 :: Integer -> Integer

mayorSemiprimoMenor5 n

| semiPrimo5 (n-1) = n-1

| otherwise = mayorSemiprimoMenor5 (n-1)

semiPrimo5 :: Integer -> Bool

semiPrimo5 x = length (primeFactors x) == 2

-- Comprobación de equivalencia

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

-- La propiedad es

prop_mayorSemiprimoMenor :: Integer -> Property

prop_mayorSemiprimoMenor n =

n > 4 ==>

all (== mayorSemiprimoMenor1 n)

[mayorSemiprimoMenor2 n,

mayorSemiprimoMenor3 n,

mayorSemiprimoMenor4 n,

mayorSemiprimoMenor5 n]

-- La comprobación es

-- λ> quickCheck prop_mayorSemiprimoMenor

-- +++ OK, passed 100 tests; 353 discarded.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mayorSemiprimoMenor1 5000

-- 4997

-- (1.92 secs, 945,507,880 bytes)

-- λ> mayorSemiprimoMenor2 5000

-- 4997

-- (0.05 secs, 123,031,264 bytes)

-- λ> mayorSemiprimoMenor3 5000

-- 4997

-- (0.01 secs, 5,865,120 bytes)

-- λ> mayorSemiprimoMenor4 5000

-- 4997

-- (0.00 secs, 593,528 bytes)

-- λ> mayorSemiprimoMenor5 5000

-- 4997

-- (0.00 secs, 593,200 bytes)

-- λ> mayorSemiprimoMenor3 (3*10^6)

-- 2999995

-- (2.34 secs, 6,713,620,000 bytes)

-- λ> mayorSemiprimoMenor4 (2*10^6)

-- 1999997

-- (0.01 secs, 728,936 bytes)

-- λ> mayorSemiprimoMenor5 (2*10^6)

-- 1999997

-- (0.01 secs, 728,608 bytes)

El código se encuentra en GitHub.

5. Particiones en k subconjuntos

Definir la función

   particiones :: [a] -> Int -> [[[a]]]

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

tal que (particiones xs k) es la lista de las particiones de xs en k subconjuntos disjuntos. Por ejemplo,

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

λ> particiones [2,3,6] 2

[[[2],[3,6]],[[2,3],[6]],[[3],[2,6]]]

λ> particiones [2,3,6] 3

[[[2],[3],[6]]]

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

[[[4],[2],[3,6]],[[4],[2,3],[6]],[[4],[3],[2,6]],

[[4,2],[3],[6]],[[2],[4,3],[6]],[[2],[3],[4,6]]]

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

[[[4,2,3,6]]]

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

[[[4],[2],[3],[6]]]

Soluciones

import Data.List (nub, sort)
import Data.Array (Array, (!), array, listArray)
import Test.QuickCheck (Positive (Positive), quickCheckWith)

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

particiones1 :: [a] -> Int -> [[[a]]]
particiones1 [] _     = []
particiones1 _  0     = []
particiones1 xs 1     = [[xs]]
particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++ 
                        concat [inserta x ys | ys <- particiones1 xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- conjuntos de yss. Por ejemplo,
--    inserta 4 [[3],[2,5]]  ==  [[[4,3],[2,5]],[[3],[4,2,5]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]

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

particiones2 :: [a] -> Int -> [[[a]]]
particiones2 [] _     = []
particiones2 _  0     = []
particiones2 xs 1     = [[xs]]
particiones2 (x:xs) k = map ([x]:) (particiones2 xs (k-1)) ++ 
                        concatMap (inserta x) (particiones2 xs k)

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

particiones3 :: [a] -> Int -> [[[a]]]
particiones3 xs k = matrizParticiones xs k ! (length xs, k)

matrizParticiones :: [a] -> Int -> Array (Int,Int) [[[a]]]
matrizParticiones xs k = q where
  q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]
  n = length xs
  v = listArray (1,n) xs
  f _ 0 = []
  f 0 _ = []
  f m 1 = [[take m xs]]
  f i j | i == j = [[[x] | x <- take i xs]]
        | otherwise = map ([v!i] :) (q!(i-1,j-1)) ++
                      concatMap (inserta (v!i)) (q!(i-1,j))

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_particiones :: [Int] -> Positive Int -> Bool
prop_particiones xs (Positive k) =
  all (iguales (particiones1 xs' k))
      [particiones2 xs' k,
       particiones3 xs' k]
  where
    xs' = nub xs
    iguales xss yss = sort (map sort [map sort x | x <- xss]) ==
                      sort (map sort [map sort y | y <- yss])

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (particiones1 [1..12] 6)
--    1323652
--    (1.33 secs, 1,152,945,584 bytes)
--    λ> length (particiones2 [1..12] 6)
--    1323652
--    (1.07 secs, 1,104,960,360 bytes)
--    λ> length (particiones3 [1..12] 6)
--    1323652
--    (1.68 secs, 1,047,004,368 bytes)

import Data.List (nub, sort)

import Data.Array (Array, (!), array, listArray)

import Test.QuickCheck (Positive (Positive), quickCheckWith)

-- 1ª solución

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

particiones1 :: [a] -> Int -> [[[a]]]

particiones1 [] _ = []

particiones1 _ 0 = []

particiones1 xs 1 = [[xs]]

particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++

concat [inserta x ys | ys <- particiones1 xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- conjuntos de yss. Por ejemplo,

-- inserta 4 [[3],[2,5]] == [[[4,3],[2,5]],[[3],[4,2,5]]]

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

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]

-- 2ª solución

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

particiones2 :: [a] -> Int -> [[[a]]]

particiones2 [] _ = []

particiones2 _ 0 = []

particiones2 xs 1 = [[xs]]

particiones2 (x:xs) k = map ([x]:) (particiones2 xs (k-1)) ++

concatMap (inserta x) (particiones2 xs k)

-- 3ª solución

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

particiones3 :: [a] -> Int -> [[[a]]]

particiones3 xs k = matrizParticiones xs k ! (length xs, k)

matrizParticiones :: [a] -> Int -> Array (Int,Int) [[[a]]]

matrizParticiones xs k = q where

q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]

n = length xs

v = listArray (1,n) xs

f _ 0 = []

f 0 _ = []

f m 1 = [[take m xs]]

f i j | i == j = [[[x] | x <- take i xs]]

| otherwise = map ([v!i] :) (q!(i-1,j-1)) ++

concatMap (inserta (v!i)) (q!(i-1,j))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particiones :: [Int] -> Positive Int -> Bool

prop_particiones xs (Positive k) =

all (iguales (particiones1 xs' k))

[particiones2 xs' k,

particiones3 xs' k]

where

xs' = nub xs

iguales xss yss = sort (map sort [map sort x | x <- xss]) ==

sort (map sort [map sort y | y <- yss])

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (particiones1 [1..12] 6)

-- 1323652

-- (1.33 secs, 1,152,945,584 bytes)

-- λ> length (particiones2 [1..12] 6)

-- 1323652

-- (1.07 secs, 1,104,960,360 bytes)

-- λ> length (particiones3 [1..12] 6)

-- 1323652

-- (1.68 secs, 1,047,004,368 bytes)

El código se encuentra en GitHub.

1. Ceros finales del factorial

Soluciones

2. Unión e intersección general de conjuntos

Soluciones

3. Intersecciones parciales

Soluciones

4. Mayor semiprimo menor que n

Soluciones

5. Particiones en k subconjuntos

Soluciones

Se puede imprimir o compartir con