Ir al contenido principal

Conjuntos de primos emparejables

Un conjunto de primos emparejables es un conjunto S de números primos tales que al concatenar cualquier par de elementos de S se obtiene un número primo. Por ejemplo, {3, 7, 109, 673} es un conjunto de primos emparejables ya que sus elementos son primos y las concatenaciones de sus parejas son 37, 3109, 3673, 73, 7109, 7673, 1093, 1097, 109673, 6733, 6737 y 673109 son primos.

Definir la función

emparejables :: Integer -> Integer -> [[Integer]]

tal que (emparejables n m) es el conjunto de los conjuntos emparejables de n elementos menores que n. Por ejemplo,

take 5 (emparejables 2   10)  ==  [[3,7]]
take 5 (emparejables 3   10)  ==  []
take 5 (emparejables 2  100)  ==  [[3,7],[3,11],[3,17],[3,31],[3,37]]
take 5 (emparejables 3  100)  ==  [[3,37,67],[7,19,97]]
take 5 (emparejables 4  100)  ==  []
take 5 (emparejables 4 1000)  ==  [[3,7,109,673],[23,311,677,827]]

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (nub, sort)
import qualified Data.Set as S

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

emparejables :: Integer -> Integer -> [[Integer]]
emparejables 0 _ = [[]]
emparejables n m =
  nub [sort (x:xs) | x <- takeWhile (<=m) primes,
                     xs <- xss,
                     all (x `emparejable`) xs]
  where xss = emparejables (n-1) m

emparejable :: Integer -> Integer -> Bool
emparejable x y =
  isPrime (concatenacion x y) &&
  isPrime (concatenacion y x)

concatenacion :: Integer -> Integer -> Integer
concatenacion x y =
  read (show x ++ show y)

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

emparejables2 :: Integer -> Integer -> [[Integer]]
emparejables2 n m = map reverse (aux n m)
  where aux 1 m = [[x] | x <- takeWhile (<=m) primes]
        aux n m = [p:ys | ys@(x:xs) <- xss,
                          p <- dropWhile (<x) ps,
                          all (p `emparejable`) ys]
          where ps  = takeWhile (<=m) primes
                xss = aux (n-1) m

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

emparejables3 :: Integer -> Integer -> [[Integer]]
emparejables3 n m = map S.toList (aux n m)
  where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
        aux n m = [S.insert x xs | x <- takeWhile (<=m) primes,
                                   xs <- xss,
                                   all (x `emparejable`) xs]
          where xss = aux (n-1) m

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

emparejables4 :: Integer -> Integer -> [[Integer]]
emparejables4 n m = map S.toList (aux n m)
  where aux 1 m = [S.singleton x | x <- takeWhile (<=m) primes]
        aux n m = [S.insert p ys
                  | ys <- xss,
                    let (x,xs) = S.deleteFindMax ys,
                    p <- dropWhile (<x) ps,
                    all (p `emparejable`) ys]
          where ps  = takeWhile (<=m) primes
                xss = aux (n-1) m

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

--    λ> head (emparejables 4 1000)
--    [3,7,109,673]
--    (20.36 secs, 11,781,891,120 bytes)
--
--    λ> head (emparejables2 4 1000)
--    [3,7,109,673]
--    (0.02 secs, 0 bytes)
--
--    λ> head (emparejables3 4 1000)
--    [3,7,109,673]
--    (38.04 secs, 21,542,334,024 bytes)
--
--    λ> head (emparejables4 4 1000)
--    [3,7,109,673]
--    (0.03 secs, 0 bytes)