Teorema de la amistad

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

1	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

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.

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

Pigeonhole among friends

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

4 Comentarios

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]

import Data.List (nub)

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)

Responder

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]))

import Data.List (group, sort, genericLength)

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]))

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]

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]

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)

import Data.List

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)

Teorema de la amistad

Soluciones

Referencia

Pensamiento

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Referencia

Pensamiento

Se puede imprimir o compartir con

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico