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, ka reunioń 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)
Medio

8 soluciones de “El problema de las celebridades

  1. albcercid
     
    import qualified Data.Map as M
    import Data.List
     
     
    celebridad :: Ord a => [(a,a)] -> Maybe a 
    celebridad xs | null (ba) = Nothing
              | otherwise = Just (head (ba))
            where a = M.keys t
                  (c:cs) = M.elems t
                  b = foldr intersect c cs
                  t = M.fromListWith (++) $ map ((x,y) -> (x,[y])) xs
  2. enrnarbej
    import Data.Set
    import Prelude hiding (map,null)
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad xs | null a = Nothing 
                  | otherwise = Just (head (toList a))
                  where
                   s = fromList xs
                   fs = map fst s
                   ss = map snd s
                   a  = ss  fs
  3. margarflo5
     
    import Data.List
     
    celebLista :: Ord a => [(a,a)] -> [a]
    celebLista xs = [x | x <- nub (map snd xs), not (x `elem` map fst xs)]
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad xs | null (celebLista xs) = Nothing
                  | otherwise = Just (head (celebLista xs))
    • antlopgom2

      Falla en la condición de que pasa por alto que todo el mundo conozca a la celebridad, como se ve en el ejemplo :
      celebridad [(1,3),(2,1)] = Just 3

  4. juacasnie
     
    import Data.List
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad r | null (celebridades r) = Nothing
                 | otherwise = Just (head (celebridades r)) 
     
    celebridades :: Ord a => [(a,a)] -> [a]
    celebridades xs = nub [ x | x <- (map (snd) xs), y <- (map (fst) xs), x `notElem` (map (fst) xs), relacionados xs y x]
     
    relacionados :: Ord a => [(a,a)] -> a -> a -> Bool
    relacionados xs x y = (x,y) `elem` xs
  5. eliguivil
    import qualified Data.Set as S
    import qualified Data.Map.Lazy as M
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad ps = aux (S.toAscList $ S.fromList (concatMap g ps))
                        (M.fromListWith (S.union) (map f ps))
      where
        f (a,b) = (a,S.singleton b)
        g (a,b) = [a,b]
        aux [] _ = Nothing
        aux (x:xs) m | M.foldrWithKey (h x) True m == True = Just x
                     | otherwise = aux xs m
        h x k a = (&&) (S.member x a)
  6. josdeher
    import Data.List as L
    import Data.Set as S
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad xs
         | length zs == 1        = Just (head zs)
         | length candidato /= 1 = Nothing
         | otherwise             = aux (head candidato) resto (S.fromList xs)
      where ys = L.nub $ L.map fst xs
            zs = L.nub $ L.map snd xs
            candidato = zs L. ys
            todos = L.union zs ys
            resto = todos L. candidato
            aux c   []   xs = Just c
            aux c (r:rs) xs | (r,c) `S.member` xs = aux c rs xs
                            | otherwise           = Nothing
  7. antlopgom2
    import Data.List
     
    celebridad :: Ord a => [(a,a)] -> Maybe a
    celebridad r | not(null xs) = Just (head xs)
                 | otherwise = Nothing
          where xs = [x | x<-personas r, escelebre x r]
     
    personas r = [x | x<-nub(map fst r ++ map snd r)]
     
    escelebre x r = all (`elem` r) [(y,x) | y<-ys] && all (`notElem` r) [(x,y) | y<-ys]
           where ys = (delete x (personas r))

Escribe tu solución

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