Menu Close

Teorema de la amistad

José A. Alonso,

El teorema de la amistad afirma que

En cualquier reunión de n personas hay al menos dos personas que tienen el mismo número de amigos (suponiendo que la relación de amistad es simétrica).

Se pueden usar las siguientes representaciones:

  • números enteros para representar a las personas,
  • pares de enteros (x,y), con x < y, para representar que la persona x e y son amigas y
  • lista de pares de enteros para representar la reunión junto con las relaciones de amistad.

Por ejemplo, [(2,3),(3,5)] representa una reunión de tres personas
(2, 3 y 5) donde

  • 2 es amiga de 3,
  • 3 es amiga de 2 y 5 y
  • 5 es amiga de 3.
    Si clasificamos las personas poniendo en la misma clase las que tienen el mismo número de amigos, se obtiene [[2,5],[3]] ya que 2 y 5 tienen 1 amigo y 3 tiene 2 amigos.

Definir la función

   clasesAmigos :: [(Int,Int)] -> [[Int]]

tal que (clasesAmigos r) es la clasificación según el número de amigos de las personas de la reunión r; es decir, la lista cuyos elementos son las listas de personas con 1 amigo, con 2 amigos y así hasta que se completa todas las personas de la reunión r. Por ejemplo,

   clasesAmigos [(2,3),(3,5)]            ==  [[2,5],[3]]
   clasesAmigos [(2,3),(4,5)]            ==  [[2,3,4,5]]
   clasesAmigos [(2,3),(2,5),(3,5)]      ==  [[2,3,5]]
   clasesAmigos [(2,3),(3,4),(2,5)]      ==  [[4,5],[2,3]]
   clasesAmigos [(x,x+1) | x <- [1..5]]  ==  [[1,6],[2,3,4,5]]
   length (clasesAmigos [(x,x+1) | x <- [1..2020]]) == 2

Comprobar con QuickCheck el teorema de la amistad; es decir, si r es una lista de pares de enteros, entonces (clasesAmigos r’) donde r’ es la lista de los pares (x,y) de r con x < y y se supone que r’ es no vacía.

Soluciones

import Data.List (nub, sort)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
clasesAmigos :: [(Int,Int)] -> [[Int]]
clasesAmigos ps =
  filter (not . null)
         [[x | x <- xs, numeroDeAmigos ps x == n] | n <- [1..length xs]] 
  where xs = personas ps
 
-- (personas ps) es la lista de personas en la reunión ps. Por ejemplo,
--    personas [(2,3),(3,5)]  ==  [2,3,5]
personas :: [(Int,Int)] -> [Int]
personas ps = sort (nub (map fst ps ++ map snd ps))
 
-- (numeroDeAmigos ps x) es el número de amigos de x en la reunión
-- ps. Por ejemplo, 
--    numeroDeAmigos [(2,3),(3,5)] 2  ==  1
--    numeroDeAmigos [(2,3),(3,5)] 3  ==  2
--    numeroDeAmigos [(2,3),(3,5)] 5  ==  1
numeroDeAmigos :: [(Int,Int)] -> Int -> Int
numeroDeAmigos ps x = length (amigos ps x)
 
-- (amigos ps x) es la lista de los amigos de x en la reunión ps. Por
-- ejemplo, 
--    amigos [(2,3),(3,5)] 2  ==  [3]
--    amigos [(2,3),(3,5)] 3  ==  [5,2]
--    amigos [(2,3),(3,5)] 5  ==  [3]
amigos :: [(Int,Int)] -> Int -> [Int]
amigos ps x =
  nub ([b | (a,b) <- ps, a == x] ++ [a | (a,b) <- ps, b == x])
 
-- 2ª solución
-- ===========
 
clasesAmigos2 :: [(Int,Int)] -> [[Int]]
clasesAmigos2 = clases . sort . tablaAmigos
  where
    clases [] = []
    clases ps@((x,y):ps') = (map snd (takeWhile (\(a,b) -> a == x) ps)) :
                            clases (dropWhile (\(a,b) -> a == x) ps')
 
-- (tablaAmigos ps) es la lista de pares (a,b) tales que b es una
-- persona de la reunión ps y a es su número de amigos. Por ejemplo,
--    tablaAmigos [(2,3),(3,5)]   ==  [(1,2),(2,3),(1,5)]
tablaAmigos :: [(Int,Int)] -> [(Int,Int)]
tablaAmigos ps = [(numeroDeAmigos ps x,x) | x <- personas ps]
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_equivalencia :: [(Int,Int)] -> Property
prop_equivalencia ps =
  not (null ps')
  ==> 
  clasesAmigos ps' == clasesAmigos2 ps'
  where ps' = [(x,y) | (x,y) <- ps, x < y]
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
--    (1.06 secs, 337,106,752 bytes)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (clasesAmigos [(x,x+1) | x <- [1..200]]) 
--    2
--    (2.37 secs, 804,402,848 bytes)
--    λ> length (clasesAmigos2 [(x,x+1) | x <- [1..200]]) 
--    2
--    (0.02 secs, 4,287,256 bytes)
 
-- El teorema de la amistad
-- ========================
 
-- La propiedad es
teoremaDeLaAmistad :: [(Int,Int)] -> Property
teoremaDeLaAmistad ps =
  not (null ps')
  ==> 
  not (null [xs | xs <- clasesAmigos2 ps', length xs > 1])
  where ps' = [(x,y) | (x,y) <- ps, x < y]
 
-- La comprobación es
--    λ> quickCheck teoremaDeLaAmistad
--    +++ OK, passed 100 tests.

Referencia

Pensamiento

Me dijo el agua clara que reía,
bajo el sol, sobre el mármol de la fuente:
si te inquieta el enigma del presente
aprende el son de la salmodia mía.

Antonio Machado

Avanzado
, , , , , , , , , , , , ,

4 soluciones de “Teorema de la amistad”

  1. Responder
    claniecas

    Una solución poco eficiente pero correcta:

    import Data.List (nub)
 
clasesAmigos :: [(Int,Int)] -> [[Int]]
clasesAmigos r = nub [mismoNAmigos n r | n <- amigos r]
 
amigos :: [(Int,Int)] -> [Int]
amigos r = nub xs
  where xs = concat [[x,y] | (x,y) <- r]
 
mismoNAmigos :: Int -> [(Int,Int)] -> [Int]
mismoNAmigos n r =
  [x | x <- amigos r
     , nAmigos n r == nAmigos x r]
 
nAmigos :: Int -> [(Int,Int)] -> Int
nAmigos n r = length (filter (==n) xs)
  where xs = concat [[x,y] | (x,y) <- r]
  2. Responder
    juabaerui 
    import Data.List (group, sort, genericLength)
 
clasesAmigos :: [(Int,Int)] -> [[Int]]
clasesAmigos xs =
  filter (/= []) [amigos n y | n <- [1..length xs]]
  where y = nAmigos xs
        amigos n xs = [x | (x,y) <- xs, y == n]
 
nAmigos :: [(Int,Int)] -> [(Int,Int)]
nAmigos xs = [(head ys, genericLength ys)| ys <- y]
  where y = group (sort (concat [[x,y] | (x,y) <- xs]))
  3. Responder
    PEDRO PORRAS DEL RIO 
    clasesAmigosA4 :: [(Int,Int)]-> [[Int]]
clasesAmigosA4 xs = filter (/=[]) (clasesAmig xs)
 
clasesAmig xs = [agrupa x xs | x <- [1..length xs]]
  where agrupa n xs = [a | (a,b) <- otra xs, b == n]
 
otra xs = zip (nub (nub2 xs)) (veces (nub2 xs))
 
nub2 [] = []
nub2 ((a,b):xs) = a:[b] ++ nub2 xs
 
veces xs = [ocurrencias x xs |x<-nub xs]
 
ocurrencias n xs = sum [1 | x<-xs, n==x]
  4. Responder
    Enrique Zubiría 
    import Data.List
 
clasesAmigos :: [(Int,Int)] -> [[Int]]
clasesAmigos as =
  filter (/=[]) (map (n -> map fst (filter ((x,y) -> y == n) nAmigos))
                     [1..(length nAmigos)-1])
  where nAmigos = zip ps (map cuentaAmigos ps)
        ps = sort $ nub $ concatMap ((x,y) -> [x,y]) as
        cuentaAmigos p = length (filter ((x,y) -> x == p || y == p) as)

Escribe tu solución

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