Menu Close

El problema de las celebridades

La celebridad de una reunión es una persona al que todos conocen pero que no conoce a nadie. Por ejemplo, si en la reunión hay tres personas tales que la 1 conoce a la 3 y la 2 conoce a la 1 y a la 3, entonces la celebridad de la reunión es la 3.

La relación de conocimiento se puede representar mediante una lista de pares (x,y) indicando que x conoce a y. Por ejemplo, la reunión anterior se puede representar por [(1,3),(2,1),(2,3)].

Definir la función

   celebridad :: Ord a => [(a,a)] -> Maybe a

tal que (celebridad r) es el justo la celebridad de r, si en r hay una celebridad y Nothing, en caso contrario. Por ejemplo,

   celebridad [(1,3),(2,1),(2,3)]            ==  Just 3
   celebridad [(1,3),(2,1),(3,2)]            ==  Nothing
   celebridad [(1,3),(2,1),(2,3),(3,1)]      ==  Nothing
   celebridad [(x,1) | x <- [2..10^6]]       ==  Just 1
   celebridad [(x,10^6) | x <- [1..10^6-1]]  ==  Just 1000000

Soluciones

import Data.List (delete, nub)
import Data.Maybe (listToMaybe)
import qualified Data.Set as S
 
-- 1ª solución
-- ===========
 
celebridad1 :: Ord a => [(a,a)] -> Maybe a
celebridad1 r =
  listToMaybe [x | x <- personas r, esCelebridad r x]
 
personas :: Ord a => [(a,a)] -> [a]
personas r =
  nub (map fst r ++ map snd r)
 
esCelebridad :: Ord a => [(a,a)] -> a -> Bool
esCelebridad r x =
     [y | y <- ys, (y,x) `elem` r] == ys
  && null [y | y <- ys, (x,y) `elem` r]
  where ys = delete x (personas r)
 
-- 2ª solución
-- ===========
 
celebridad2 :: Ord a => [(a,a)] -> Maybe a
celebridad2 r =
  listToMaybe [x | x <- personas2 c, esCelebridad2 c x]
  where c = S.fromList r
 
--    λ> personas2 (S.fromList [(1,3),(2,1),(2,3)])
--    [1,2,3]
personas2 :: Ord a => S.Set (a,a) -> [a]
personas2 c =
  S.toList (S.map fst c `S.union` S.map snd c)
 
esCelebridad2 :: Ord a => S.Set (a,a) -> a -> Bool
esCelebridad2 c x = 
      [y | y <- ys, (y,x) `S.member` c] == ys
   && null [y | y <- ys, (x,y) `S.member` c]
   where ys = delete x (personas2 c)
 
-- 3ª definición
-- =============
 
celebridad3 :: Ord a => [(a,a)] -> Maybe a
celebridad3 r
  | S.null candidatos = Nothing
  | esCelebridad      = Just candidato
  | otherwise         = Nothing
  where
    conjunto          = S.fromList r
    dominio           = S.map fst conjunto
    rango             = S.map snd conjunto
    total             = dominio `S.union` rango
    candidatos        = rango `S.difference` dominio
    candidato         = S.findMin candidatos
    noCandidatos      = S.delete candidato total
    esCelebridad      =
      S.filter (\x -> (x,candidato) `S.member` conjunto) total == noCandidatos
 
-- Comparación de eficiencia
-- =========================
 
--    λ> celebridad1 [(x,1) | x <- [2..300]]
--    Just 1
--    (2.70 secs, 38,763,888 bytes)
--    λ> celebridad2 [(x,1) | x <- [2..300]]
--    Just 1
--    (0.01 secs, 0 bytes)
-- 
--    λ> celebridad2 [(x,1000) | x <- [1..999]]
--    Just 1000
--    (2.23 secs, 483,704,224 bytes)
--    λ> celebridad3 [(x,1000) | x <- [1..999]]
--    Just 1000
--    (0.02 secs, 0 bytes)
-- 
--    λ> celebridad3 [(x,10^6) | x <- [1..10^6-1]]
--    Just 1000000
--    (9.56 secs, 1,572,841,088 bytes)
--    λ> celebridad3 [(x,1) | x <- [2..10^6]]
--    Just 1
--    (6.17 secs, 696,513,320 bytes)

9 soluciones de “El problema de las celebridades

  1. jaibengue

    Supongo que en la reunión no hay alguien que ni conozca a nadie ni nadie le conozca y además que ninguna relación se repite en la lista. (?)

  2. alerodrod5
     
    import Data.List
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad xs = aux [y | (x,y) <- xs, (length ((filter (==y)) (map snd xs))) == length (nub (map fst xs))]
      where aux [] = Nothing
            aux xs = Just (head xs)
    • jaibengue
      -- λ> celebridad [(1,2),(1,3)]
      -- Just 2
  3. albcarcas1

    Es un ejemplo poco eficiente, pero funciona

    import Data.List
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad xs | nub ms == ms = Just (head[x | (x,y) <- zip (map head cs) ms,
                                                              y == maximum(ms)])
                  | otherwise    = Nothing
      where cs = (group . sort . map snd) xs
            ms = map length cs
    • jaibengue
      -- λ> celebridad [(1,2),(3,4),(3,2)]
      -- Just 2
  4. menvealer
    import Data.List 
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad ps
      | ls == nub ls = Just $ head [x | (x,y) <- zip (map head xs) ls , y == c]
      | otherwise = Nothing
      where xs = (group . sort . snd . unzip) ps
            ls = map length xs
             c = maximum ls
    • jaibengue
      -- λ> celebridad [(1,2),(3,4),(3,2)]
      -- Just 2
  5. jaibengue
    celebridad :: Ord a => [(a,a)] ->  Maybe a
    celebridad zs | numPer - numPrimeros /= 1     = Nothing
                  | fst lenSegundo == (numPer-1) = Just (snd lenSegundo)
                  | otherwise = Nothing
      where numPer = length $
                     mergeOrd nubPrimeros nubSegundos
            numPrimeros = length nubPrimeros
            lenSegundo = greatestLAndFriend
                         (group sortSegundos)
                         (-1, head sortPrimeros)
            sortPrimeros = sort primeros
            sortSegundos = sort segundos
            nubPrimeros = nubOrd sortPrimeros
            nubSegundos = nubOrd sortSegundos
            primeros = map fst zs
            segundos = map snd zs
     
            nubOrd (x:p@(y:xs)) | x == y    = nubOrd p
                                | otherwise = x:nubOrd p
            nubOrd [e1] = [e1]
            nubOrd []   = []
     
            mergeOrd p@(x:xs) q@(y:ys) | x < y     = x:mergeOrd xs q
                                       | x==y      = mergeOrd xs q
                                       | otherwise = y:mergeOrd p ys
            mergeOrd [] ys = ys
            mergeOrd xs [] = xs
     
            greatestLAndFriend ((x:xs):xss) p@(n,e) | noMeQuedanNombresOriginalesDeVariable < n = greatestLAndFriend xss p
                                                    | otherwise     = greatestLAndFriend xss (noMeQuedanNombresOriginalesDeVariable, x)
              where noMeQuedanNombresOriginalesDeVariable = 1+length xs
            greatestLAndFriend _ p = p

    (?)

  6. María Ruiz
     
    import Data.Maybe
    import qualified Data.Map as M
    import qualified Data.Set as S
     
     
    -- Con diccionarios y conjuntos:
     
    -- Diccionario a partir de la lista de pares:
     
    diccionarioS :: Ord a => [(a,a)] -> M.Map a (S.Set a)
    diccionarioS ps = foldr f M.empty ps
      where f (x,y) d = M.insertWith S.union x (S.singleton y) d
     
     
    -- Intersección de una lista no vacía de conjuntos
     
    interseccionG :: Ord a => [S.Set a] -> S.Set a
    interseccionG xss = foldr1 S.intersection xss
     
    -- La celebridad no conoce a nadie y todos la conocen:
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad ps =
      listToMaybe $ S.elems  $ S.difference (interseccionG bs) (S.fromList as)
      where d = diccionarioS ps
            bs = M.elems d
            as = M.keys d

Leave a Reply to María Ruiz Cancel reply

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