Menu Close

El problema de las celebridades

José A. Alonso,

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)
Posted in Medio
Tagged , , , , , , , , , , , , , , , , , ,

9 Comments

  1. jaibengue
    Responder

    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
    Responder 
     
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)
  3. albcarcas1
    Responder

    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
  4. menvealer
    Responder 
    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
  5. jaibengue
    Responder 
    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
    Responder 
     
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 RuizCancel reply

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