Menu Close

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

4 soluciones de “Conjuntos de primos emparejables

  1. josejuan

    No conozco ninguna propiedad que permita reducir el comparar todos con todos los primos, por lo que el coste es básicamente O(m^2), así, para m>100000 es impracticable, por lo que sólo sirve para n<6 y m<100000.

    import System.Environment
    import Data.Numbers.Primes
    import Data.Map.Strict ((!))
    import qualified Data.Map.Strict as M
    import qualified Data.Set as S
    import Math.NumberTheory.Logarithms (integerLog10)
    import Control.Parallel
    import Control.Parallel.Strategies
     
    -- Un primo p tiene sus emparejables mayores que él
    -- Ej. [(3,[7,11,17]),(7,[19]),(11,[23]),(13,[19])]
    parSet :: Integer ->M.Map Integer (S.Set Integer)
    parSet m = M.fromList rs
      where rs = [(fst x, S.fromDistinctAscList (fmap fst $ filter (check x) xs)) | (x, xs) <-ps] `using` parListChunk 64 rdeepseq
            ps = pares [(p, 10^(1 + integerLog10 p)) | p <-takeWhile (<m) primes]
            pares [] = []
            pares (x:xs) = (x, xs): pares xs -- más rápido que tails
            check (a, u) (b, v) = isPrime (a * v + b) && isPrime (b * u + a)
     
    -- Para cada clave bajamos por el árbol haciendo intersección de emparejados
    emparejables :: Integer ->Integer ->[[Integer]]
    emparejables n m =
      let rel = parSet m
          get 2 i = fmap (:[]) $ S.toList i
          get z i = do p <-S.toList i
                       (p:) <$> maybe [] (get (z-1) . S.intersection i) (M.lookup p rel)
      in  do
            p <-M.keys rel
            (p:) <$> (get n (rel!p))
     
    {-
     
    [josejuan@centella hask]$ crono ./empar 4 1000 +RTS -N6
    [[3,7,109,673],[23,311,677,827]]
    Mem: 7300 kbytes. Time: 0:00.03
     
    [josejuan@centella hask]$ crono ./empar 5 10000 +RTS -N6
    [[13,5197,5701,6733,8389]]
    Mem: 15436 kbytes. Time: 0:01.60
    [josejuan@centella hask]$
     
    -}
    main = do
      (n:m:_) <-(read <$>) <$> getArgs
      print $ take 5 $ emparejables n m
  2. alvalvdom1
    import Data.Char
    import Data.List
     
    -- La ordenación de (combinaciones n xs) es distinta a la de los
    -- ejemplos, por lo que en el ejemplo: 
    --    take 5 (emparejables 2  100)  == [[3,7],[3,11],[3,17],[3,31],[3,37]]
    -- mi definición da como resultado: 
    --    take 5 (emparejables 2  100)  == [[3,7],[3,11],[3,17],[7,19],[13,19]]
     
    emparejables :: Integer -> Integer -> [[Integer]]
    emparejables n m =
        [xs | xs <- combinaciones n (takeWhile (<m) primes),
              all isPrime (empareja xs)]
     
    combinaciones :: Integer -> [a] -> [[a]]
    combinaciones n xs =
        [ys | ys <- subsequences xs, genericLength ys == n]
     
    empareja :: [Integer] -> [Integer]
    empareja [] = []
    empareja xs = map numeros (concat [aux x xs | x <- xs])
        where aux _ [] = []
              aux x xs = [x : [y] | y <- xs \ [x]]
     
    numeros :: [Integer] -> Integer
    numeros xs = read [x | x <- show xs, isDigit x]
  3. fracruzam

    Generando progresivamente con un pelín de fuerza bruta

    import Data.Numbers.Primes
     
    emparejables :: Integer -> Integer -> [[Integer]]
    emparejables 1 m = [[x] | x <- takeWhile (< m) primes]
    emparejables n m = pruebaParejas xss ps
      where ps  = takeWhile (< m) primes
            xss = emparejables (n-1) m
     
    pruebaParejas :: [[Integer]] -> [Integer] -> [[Integer]]
    pruebaParejas (xs:xss) ps = 
      [xs ++ [p] | p <- dropWhile (<= last xs) ps, buenaPareja xs p] ++ 
      pruebaParejas xss ps
    pruebaParejas  _       _         = []
     
    buenaPareja :: [Integer] -> Integer -> Bool
    buenaPareja xs p = all isPrime [toNumber [x,y] | x <- ys, y <- ys, x /= y]
      where ys = p:xs
       -- *Main> buenaPareja [3,7,109] 673
       -- True
     
    toNumber :: [Integer] -> Integer
    toNumber [x,y] = x*10^n+y
      where n = length (show y)
       -- *Main> toNumber [123,4567]
       -- 1234567
  4. Maria Ruiz
    import Data.Numbers.Primes
    import Data.List
     
    emparejable :: Integer -> Integer -> Bool
    emparejable x y = 
        isPrime (read (show x ++ show y)) && 
        isPrime (read (show y ++ show x))
     
     
    sig :: Integer -> Integer -> [Integer] -> [[Integer]]
    sig m n xs | genericLength xs == m = [xs]
               | otherwise      = [xs ++ [y] | y <- dropWhile (<=z) ps,
                                   and [emparejable x y | x <-xs]]
               where ps = takeWhile (<n) primes
                     z = last xs
     
    emparejables :: Integer -> Integer -> [[Integer]]
    emparejables m n = concat [until pred f [[p]] | p <- takeWhile (<n) (primes \ [2,5])]
        where f = concatMap (sig m n)
              pred xss = f xss == xss

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.