snd

Reparto de escaños por la ley d’Hont

PorJosé A. Alonso 23-abril-201925-abril-2021

El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten

Definir la función

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

1	reparto :: Int -> [Int] -> [(Int,Int)]

tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

ghci> reparto 7 [340000,280000,160000,60000,15000]

[(1,3),(2,3),(3,1)]

ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]

[(1,9),(2,7),(3,4),(4,1)]

es decir, en el primer ejemplo,

al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]

-- 1ª solución
-- ===========

reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- 2ª solución
-- ===========

reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de

-- votos entre 5 partidos.

ejVotos :: [Int]

ejVotos = [340000,280000,160000,60000,15000]

-- 1ª solución

-- ===========

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

reparto n vs =

[(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))]

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que

-- obtienen los n escaños. Por ejemplo,

-- ghci> repartoAux 7 ejVotos

-- [1,2,1,3,2,1,2]

repartoAux :: Int -> [Int] -> [Int]

repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores

-- correspondientes a la lista de votos vs. Por ejemplo,

-- ghci> repartoAux' 7 ejVotos

-- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),

-- (93333,2)]

repartoAux' :: Int -> [Int] -> [(Int,Int)]

repartoAux' n vs =

take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y

-- el número de cada partido. Por ejemplo,

-- ghci> votosPartidos ejVotos

-- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]

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

votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.

-- Por ejemplo,

-- ghci> restos 5 (340000,1)

-- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]

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

restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- 2ª solución

-- ===========

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

reparto2 n xs =

( map (\x -> (head x, length x))

. group

. sort

. map snd

. take n

. reverse

. sort

) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

Pensamiento

Sus cantares llevan
agua de remanso,
que parece quieta.
Y que no lo está;
mas no tiene prisa
por ir a la mar.

Antonio Machado

Tren de potencias

PorJosé A. Alonso 23-julio-201824-julio-2018

Si n es el número natural cuya expansión decimal es abc… , el tren de potencias de n es a^bc^d… donde el último exponente es 1, si n tiene un número impar de dígitos. Por ejemplo

   trenDePotencias 2453  = 2^4*5^3     = 2000
   trenDePotencias 24536 = 2^4*5^3*6^1 = 12000

1 2	trenDePotencias 2453 = 2^45^3 = 2000 trenDePotencias 24536 = 2^45^3*6^1 = 12000

Definir las funciones

   trenDePotencias            :: Integer -> Integer
   esPuntoFijoTrenDePotencias :: Integer -> Bool
   puntosFijosTrenDePotencias :: [Integer]
   tablaTrenDePotencias       :: Integer -> Integer -> IO ()

trenDePotencias :: Integer -> Integer

esPuntoFijoTrenDePotencias :: Integer -> Bool

puntosFijosTrenDePotencias :: [Integer]

tablaTrenDePotencias :: Integer -> Integer -> IO ()

tales que

(trenDePotencias n) es el tren de potencia de n. Por ejemplo.

     trenDePotencias 20   ==  1
     trenDePotencias 21   ==  2
     trenDePotencias 24   ==  16
     trenDePotencias 39   ==  19683
     trenDePotencias 623  ==  108

trenDePotencias 20 == 1

trenDePotencias 21 == 2

trenDePotencias 24 == 16

trenDePotencias 39 == 19683

trenDePotencias 623 == 108

(esPuntoFijoTrenDePotencias n) se verifica si n es un punto fijo de trenDePotencias; es decir, (trenDePotencias n) es igual a n. Por ejemplo,

     esPuntoFijoTrenDePotencias 2592                        ==  True
     esPuntoFijoTrenDePotencias 24547284284866560000000000  ==  True

1 2	esPuntoFijoTrenDePotencias 2592 == True esPuntoFijoTrenDePotencias 24547284284866560000000000 == True

puntosFijosTrenDePotencias es la lista de los puntso fijos de trenDePotencias. Por ejemplo,

     take 10 puntosFijosTrenDePotencias  ==  [1,2,3,4,5,6,7,8,9,2592]

1	take 10 puntosFijosTrenDePotencias == [1,2,3,4,5,6,7,8,9,2592]

(tablaTrenDePotencias a b) es la tabla de los trenes de potencias de los números entre a y b. Por ejemplo,

     λ> tablaTrenDePotencias 20 39
     | 20 |     1 |
     | 21 |     2 |
     | 22 |     4 |
     | 23 |     8 |
     | 24 |    16 |
     | 25 |    32 |
     | 26 |    64 |
     | 27 |   128 |
     | 28 |   256 |
     | 29 |   512 |
     | 30 |     1 |
     | 31 |     3 |
     | 32 |     9 |
     | 33 |    27 |
     | 34 |    81 |
     | 35 |   243 |
     | 36 |   729 |
     | 37 |  2187 |
     | 38 |  6561 |
     | 39 | 19683 |
     λ> tablaTrenDePotencias 2340 2359
     | 2340 |        8 |
     | 2341 |       32 |
     | 2342 |      128 |
     | 2343 |      512 |
     | 2344 |     2048 |
     | 2345 |     8192 |
     | 2346 |    32768 |
     | 2347 |   131072 |
     | 2348 |   524288 |
     | 2349 |  2097152 |
     | 2350 |        8 |
     | 2351 |       40 |
     | 2352 |      200 |
     | 2353 |     1000 |
     | 2354 |     5000 |
     | 2355 |    25000 |
     | 2356 |   125000 |
     | 2357 |   625000 |
     | 2358 |  3125000 |
     | 2359 | 15625000 |

λ> tablaTrenDePotencias 20 39

| 20 | 1 |

| 21 | 2 |

| 22 | 4 |

| 23 | 8 |

| 24 | 16 |

| 25 | 32 |

| 26 | 64 |

| 27 | 128 |

| 28 | 256 |

| 29 | 512 |

| 30 | 1 |

| 31 | 3 |

| 32 | 9 |

| 33 | 27 |

| 34 | 81 |

| 35 | 243 |

| 36 | 729 |

| 37 | 2187 |

| 38 | 6561 |

| 39 | 19683 |

λ> tablaTrenDePotencias 2340 2359

| 2340 | 8 |

| 2341 | 32 |

| 2342 | 128 |

| 2343 | 512 |

| 2344 | 2048 |

| 2345 | 8192 |

| 2346 | 32768 |

| 2347 | 131072 |

| 2348 | 524288 |

| 2349 | 2097152 |

| 2350 | 8 |

| 2351 | 40 |

| 2352 | 200 |

| 2353 | 1000 |

| 2354 | 5000 |

| 2355 | 25000 |

| 2356 | 125000 |

| 2357 | 625000 |

| 2358 | 3125000 |

| 2359 | 15625000 |

Comprobar con QuickCheck que entre 2593 y 24547284284866559999999999 la función trenDePotencias no tiene puntos fijos.

Soluciones

Puedes escribir tus soluciones en los comentarios o ver las soluciones propuestas pulsando [expand title=»aquí»]

import Test.QuickCheck
import Text.Printf

-- 1ª definición de trenDePotencias
-- ================================

trenDePotencias :: Integer -> Integer
trenDePotencias = trenDePotenciasLN . digitos

-- (digitos n) es la lista de los dígitos del número n. Por ejemplo,
--    digitos 2018  ==   [2,0,1,8]
digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]

-- (trenDePotenciasLN xs) es el tren de potencias de la lista de números
-- xs. Por ejemplo,
--    trenDePotenciasLN [2,4,5,3]    ==   2000
--    trenDePotenciasLN [2,4,5,3,6]  ==   12000
trenDePotenciasLN :: [Integer] -> Integer
trenDePotenciasLN []       = 1
trenDePotenciasLN [x]      = x
trenDePotenciasLN (u:v:ws) = u ^ v * (trenDePotenciasLN ws) 

-- 2ª definición de trenDePotencias
-- ================================

trenDePotencias2 :: Integer -> Integer
trenDePotencias2 = trenDePotenciasLN2 . digitos

-- (trenDePotenciasLN2 xs) es el tren de potencias de la lista de números
-- xs. Por ejemplo,
--    trenDePotenciasLN2 [2,4,5,3]    ==   2000
--    trenDePotenciasLN2 [2,4,5,3,6]  ==   12000
trenDePotenciasLN2 :: [Integer] -> Integer
trenDePotenciasLN2 xs =
  product [x^y | (x,y) <- pares xs]

-- (pares xs) es la lista de los pares de elementos en la posiciones
-- pares y sus siguientes; si la longitud de xs es impar, la segunda
-- componente del último par es 1. Por ejemplo,
--    pares [2,4,5,3]    ==   [(2,4),(5,3)]
--    pares [2,4,5,3,6]  ==   [(2,4),(5,3),(6,1)]
pares :: [Integer] -> [(Integer,Integer)]
pares []       = []
pares [x]      = [(x,1)]
pares (x:y:zs) = (x,y) : pares zs

-- Equivalencia
-- ============

-- La propiedad es
prop_equivalencia :: (Positive Integer) -> Bool
prop_equivalencia (Positive n) =
  trenDePotencias n == trenDePotencias2 n

-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

--    λ> let n = 2*10^5 in trenDePotencias (read (replicate n '2')) == 2^n
--    True
--    (2.11 secs, 2,224,301,136 bytes)
--    λ> let n = 2*10^5 in trenDePotencias2 (read (replicate n '2')) == 2^n
--    True
--    (2.08 secs, 2,237,749,216 bytes)

-- Definición de esPuntoFijoTrenDePotencias
-- ========================================

esPuntoFijoTrenDePotencias :: Integer -> Bool
esPuntoFijoTrenDePotencias n =
  trenDePotencias n == n

-- Definición de puntosFijosTrenDePotencias
-- ========================================

puntosFijosTrenDePotencias :: [Integer]
puntosFijosTrenDePotencias =
  filter esPuntoFijoTrenDePotencias [1..]

-- Definición de tablaTrenDePotencias
-- ==================================

tablaTrenDePotencias :: Integer -> Integer -> IO ()
tablaTrenDePotencias a b =
  sequence_ [printf cabecera x y | (x,y) <- trenes]
  where trenes  = [(n,trenDePotencias n) | n <- [a..b]]
        m1      = show (1 + length (show b))
        m2      = show (length (show (maximum (map snd trenes))))
        cabecera = concat ["|% ",m1,"d | %", m2,"d |\n"]

-- Comprobación
-- ============

-- La propiedad es
prop_puntosFijos :: Positive Integer -> Property
prop_puntosFijos (Positive n) =
  x < 24547284284866560000000000 ==> not (esPuntoFijoTrenDePotencias x)
  where x = 2593 + n 

-- La comprobación es
--    λ> quickCheck prop_puntosFijos
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

import Test.QuickCheck

import Text.Printf

-- 1ª definición de trenDePotencias

-- ================================

trenDePotencias :: Integer -> Integer

trenDePotencias = trenDePotenciasLN . digitos

-- (digitos n) es la lista de los dígitos del número n. Por ejemplo,

-- digitos 2018 == [2,0,1,8]

digitos :: Integer -> [Integer]

digitos n =

[read [c] | c <- show n]

-- (trenDePotenciasLN xs) es el tren de potencias de la lista de números

-- xs. Por ejemplo,

-- trenDePotenciasLN [2,4,5,3] == 2000

-- trenDePotenciasLN [2,4,5,3,6] == 12000

trenDePotenciasLN :: [Integer] -> Integer

trenDePotenciasLN [] = 1

trenDePotenciasLN [x] = x

trenDePotenciasLN (u:v:ws) = u ^ v * (trenDePotenciasLN ws)

-- 2ª definición de trenDePotencias

-- ================================

trenDePotencias2 :: Integer -> Integer

trenDePotencias2 = trenDePotenciasLN2 . digitos

-- (trenDePotenciasLN2 xs) es el tren de potencias de la lista de números

-- xs. Por ejemplo,

-- trenDePotenciasLN2 [2,4,5,3] == 2000

-- trenDePotenciasLN2 [2,4,5,3,6] == 12000

trenDePotenciasLN2 :: [Integer] -> Integer

trenDePotenciasLN2 xs =

product [x^y | (x,y) <- pares xs]

-- (pares xs) es la lista de los pares de elementos en la posiciones

-- pares y sus siguientes; si la longitud de xs es impar, la segunda

-- componente del último par es 1. Por ejemplo,

-- pares [2,4,5,3] == [(2,4),(5,3)]

-- pares [2,4,5,3,6] == [(2,4),(5,3),(6,1)]

pares :: [Integer] -> [(Integer,Integer)]

pares [] = []

pares [x] = [(x,1)]

pares (x:y:zs) = (x,y) : pares zs

-- Equivalencia

-- ============

-- La propiedad es

prop_equivalencia :: (Positive Integer) -> Bool

prop_equivalencia (Positive n) =

trenDePotencias n == trenDePotencias2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- λ> let n = 2*10^5 in trenDePotencias (read (replicate n '2')) == 2^n

-- True

-- (2.11 secs, 2,224,301,136 bytes)

-- λ> let n = 2*10^5 in trenDePotencias2 (read (replicate n '2')) == 2^n

-- True

-- (2.08 secs, 2,237,749,216 bytes)

-- Definición de esPuntoFijoTrenDePotencias

-- ========================================

esPuntoFijoTrenDePotencias :: Integer -> Bool

esPuntoFijoTrenDePotencias n =

trenDePotencias n == n

-- Definición de puntosFijosTrenDePotencias

-- ========================================

puntosFijosTrenDePotencias :: [Integer]

puntosFijosTrenDePotencias =

filter esPuntoFijoTrenDePotencias [1..]

-- Definición de tablaTrenDePotencias

-- ==================================

tablaTrenDePotencias :: Integer -> Integer -> IO ()

tablaTrenDePotencias a b =

sequence_ [printf cabecera x y | (x,y) <- trenes]

where trenes = [(n,trenDePotencias n) | n <- [a..b]]

m1 = show (1 + length (show b))

m2 = show (length (show (maximum (map snd trenes))))

cabecera = concat ["|% ",m1,"d | %", m2,"d |\n"]

-- Comprobación

-- ============

-- La propiedad es

prop_puntosFijos :: Positive Integer -> Property

prop_puntosFijos (Positive n) =

x < 24547284284866560000000000 ==> not (esPuntoFijoTrenDePotencias x)

where x = 2593 + n

-- La comprobación es

-- λ> quickCheck prop_puntosFijos

-- +++ OK, passed 100 tests.

[/expand]

Caminos en un grafo

PorJosé A. Alonso 18-mayo-201825-abril-2021

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

-- =========================

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Problema del dominó

PorJosé A. Alonso 16-mayo-201823-mayo-2018

Las fichas del dominó se pueden representar por pares de números enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Definir la función

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

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   λ> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   λ> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   λ> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   λ> domino [(1,2),(2,3),(5,4)]
   []
   λ> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])
   9
   λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0
   λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])
   84480

λ> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

λ> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

λ> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

λ> domino [(1,2),(2,3),(5,4)]

[]

λ> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])

λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])

84480

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)
-- =====================================

-- Las fichas son pares de números enteros.
type Ficha  = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar
type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.
inicial :: Problema -> Estado
inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.
esFinal :: Estado -> Bool
esFinal (fs,_) = null fs 

sucesores :: Estado -> [Estado]
sucesores (fs,[]) =
  [(delete f fs, [f]) | f <- fs]
sucesores (fs,n@((x,y):qs)) =
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
  [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

soluciones :: Problema -> [Estado]
soluciones p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]
domino ps = map snd (soluciones ps)
      
-- 2ª solución (por búsqueda en profundidad)
-- =========================================

soluciones2 :: Problema -> [Estado]
soluciones2 p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]
domino2 ps = map snd (soluciones2 ps)
      
-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)
-- =================================================

domino3 :: Problema -> [[Ficha]]
domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]
soluciones3 ps = buscaEE sucesores
                         esFinal         
                         (inicial ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)

-- =====================================

-- Las fichas son pares de números enteros.

type Ficha = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar

type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.

inicial :: Problema -> Estado

inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.

esFinal :: Estado -> Bool

esFinal (fs,_) = null fs

sucesores :: Estado -> [Estado]

sucesores (fs,[]) =

[(delete f fs, [f]) | f <- fs]

sucesores (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

soluciones :: Problema -> [Estado]

soluciones p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]

domino ps = map snd (soluciones ps)

-- 2ª solución (por búsqueda en profundidad)

-- =========================================

soluciones2 :: Problema -> [Estado]

soluciones2 p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]

domino2 ps = map snd (soluciones2 ps)

-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)

-- =================================================

domino3 :: Problema -> [[Ficha]]

domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]

soluciones3 ps = buscaEE sucesores

esFinal

(inicial ps)

El problema de las celebridades

PorJosé A. Alonso 15-mayo-201822-mayo-2018

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

1	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

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)

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)

Tren de potencias

Soluciones

Caminos en un grafo

Soluciones

Problema del dominó

Soluciones

El problema de las celebridades

Soluciones

Entradas recientes

Buscar

Correo electrónico