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
-- 2ª 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)