Conjuntos de primos emparejables

PorJosé A. Alonso 9-mayo-201625-abril-2021

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

1	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]]

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)

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 Comentarios

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

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

Responder

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]

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]

Responder

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

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

Responder

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

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

Responder

Conjuntos de primos emparejables

Soluciones

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico