Menu Close

Conjuntos de primos emparejables

José A. Alonso,

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

4 soluciones de “Conjuntos de primos emparejables”

  1. Responder
    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. Responder
    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. Responder
    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. Responder
    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.