Teorema de la amistad

José A. Alonso

17-01-2020

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 so 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

-- 2ª 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

Pigeonhole among friends