Menu Close

Distancia a Erdős

José A. Alonso,

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

data Arbol a = N a [Arbol a]
             deriving Show 
 
coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]
 
-- 1ª solución
-- ===========
 
numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")
 
-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]
 
-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs
 
-- 2ª solución
-- ===========
 
numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]
 
-- 3ª solución
-- ===========
 
numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n
 
-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]
 
-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))
Avanzado
, , , , , , , , , , , , , ,

6 soluciones de “Distancia a Erdős”

  1. Responder
    albcercid 
    numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]
  2. Responder
    enrnarbej 
    data Arbol a = N a [Arbol a]
  deriving Show 
 
numeroDeErdos :: Int -> [(String, String)] -> [String]
numeroDeErdos n xs = autores n (arbolDeErdos xs "Paul Erdos")
 
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]
 
filtra :: Eq a => a -> (a,a) -> a
filtra a (x,y) | a == x    = y
               | otherwise = x
 
autores :: Int -> Arbol String -> [String]
autores 0 (N a xs) = [a]
autores n (N a xs) = concat $ map (autores (n-1)) xs
  3. Responder
    josejuan 
    {-
    Si hay `n` coautores, usando Floy-Warshall se pueden obtener
    todos los números de Erdos en O(n^3) directamente.
 
    Usando Dijkstra, como sólo hay un nodo orígen se pueden obtener
    en O(n^2 * log n) iterando para cada otro coautor.
 
    Sin embargo, si llamamos `c` al nº medio de colaboradores
    para cada autor, podemos reducirlo a O(c * n * log n) aunque
    realmente es algo como
 
      O(c * (g1 * log T + g2 * log (T-g1) + g3 * log (T-g1-g2) + ...
 
    que es menor.
 
    La forma es realizar operaciones unión/intersección de `Set` ya
    que todas ellas tienen coste el de menor longitud.
-}
import Data.Map (Map, (!))
import Data.Set (Set)
import qualified Data.Map as M
import qualified Data.Set as S
 
-- convierte la lista indicada en un grafo no dirigido
undirected :: [(String, String)] ->Map String (Set String)
undirected xs = M.fromListWith S.union $ concat [[(a, S.singleton b), (b, S.singleton a)] | (a, b) <-xs]
 
-- calcula todas las órbitas, es decir, los erdos 0, erdos 1, erdos 2, ...
orbits :: Map String (Set String) ->Set String ->[Set String]
orbits m s = s: i s
  where i s = if S.null c then [] else c: i (c `S.union` s)
              where c = S.unions (S.elems$ S.map (m!) s) `S.difference` s
 
-- convierte la entrada a grafo e indexa el elemento solicitado
numeroDeErdos :: [(String, String)] ->Int ->[String]
numeroDeErdos xs k = S.elems$ (orbits (undirected xs) (S.singleton "Paul Erdos"))!!k
 
{-
> mapM_ print $ orbits (undirected coautores) (S.singleton "Paul Erdos")
fromList ["Paul Erdos"]
fromList ["A. J. Granville","D. Kleitman","Ernst Straus","J. Conway","Pascual Jordan"]
fromList ["Albert Einstein","B. Mazur","John von Newmann","P. Doyle","S. Glashow"]
fromList ["Andrew Wiles","David Hilbert","M. Gell-Mann","Otto Stern","Wolfgang Pauli"]
fromList ["David Pines","Richar Feynman"]
fromList ["A. Bohr","D. Bohm"]
fromList ["L. De Broglie"]
-}
  4. Responder
    María Ruiz 
    import Data.List
 
coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]
 
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap ((x,y) -> [x,y]))
 
suc :: Eq a => a -> [(a, a)] -> [[a]]
suc a ps = takeWhile (not . null) (map fst (iterate sig ([a], as \ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \ zs)
          where zs = [y | y <- ys, or [elem (x,y) ps || elem (y,x) ps | x <-xs]]
 
numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos ps n = (suc "Paul Erdos" coautores) !! n
  5. Responder
    Chema Cortés 
    import Data.Maybe (mapMaybe)
 
numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos _ 0   = ["Paul Erdos"]
numeroDeErdos xs n  = mapMaybe (correspondeCon cercanos) xs
  where cercanos = numeroDeErdos xs =<< [0..n-1]
 
correspondeCon ::  [String] -> (String, String) -> Maybe String
correspondeCon xs (a,b) | a `elem` xs && b `elem` xs  = Nothing
                        | a `elem` xs                 = Just b
                        | b `elem` xs                 = Just a
                        | otherwise                   = Nothing
  6. Responder
    Juanjo Ortega (juaorture) 
    -- Nota: las soluciones las da en un orden diferente.
 
import Data.List
 
numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n =
  nub ([b | a <- xs
          , let b = fst a
          , distanciaErdos b == n]
       ++ [b | a <- xs
             , let b = snd a
             , distanciaErdos b == n])
 
distanciaErdos :: String -> Int
distanciaErdos xs
  | y < 2 || y == 999 = y
  | otherwise         = 2
  where y = posicion xs (iteraColab "Paul Erdos")
 
iteraColab :: String -> [[String]]
iteraColab xs =
  [[xs]] ++ [ys] ++ [(colaboradores a) \ [xs] | a <- ys]
  where ys = colaboradores xs
 
posicion :: String -> [[String]] -> Int
posicion xs (ys:yss)
  | xs `elem` ys                                   = 0
  | not (any (==True) [ xs `elem` zs | zs <- yss]) = 999
  | otherwise                                      = 1 + posicion xs yss
 
colaboradores :: String -> [String]
colaboradores xs =
  [fst a | a <- coautores
         , snd a == xs]
  ++ [snd a | a <- coautores
            , fst a == xs]
 
coautores :: [(String,String)]
coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

Escribe tu solución

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