import Data.Ix
import Data.List (delete, sort)
import qualified Data.Set as S
import I1M.Grafo
import I1M.Tabla
import Data.Numbers.Primes (primeFactors)
grafoDivisibilidad :: Int -> Grafo Int Int
grafoDivisibilidad n =
creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]
, x <- [1..y-1]
, y `mod` x == 0]
-- 1ª solución (con el algoritmo de Kruskal)
-- =========================================
coste1 :: Int -> Int
coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]
-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Kruskal. Por ejemplo,
-- λ> kruskal (grafoDivisibilidad 12)
-- [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),
-- (2,4,8),(2,3,6),(2,2,4),(2,1,2)]
kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = kruskal' cola -- Cola ordenada
(tabla [(x,x) | x <- nodos g]) -- Tabla de raices
[] -- Árbol de expansión
(length (nodos g) - 1) -- Aristas por
-- colocar
where cola = sort [(p,x,y) | (x,y,p) <- aristas g]
kruskal' ((p,x,y):as) t ae n
| n == 0 = ae
| actualizado = kruskal' as t' ((p,x,y):ae) (n-1)
| otherwise = kruskal' as t ae n
where (actualizado,t') = buscaActualiza (x,y) t
-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,
-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5 == 1
-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2 == 6
raiz:: Eq n => Tabla n n -> n -> n
raiz t x | v == x = v
| otherwise = raiz t v
where v = valor t x
-- (buscaActualiza a t) es el par formado por False y la tabla t, si los
-- dos vértices de la arista a tienen la misma raíz en t y el par
-- formado por True y la tabla obtenida añadiéndole a t la arista
-- formada por el vértice de a de mayor raíz y la raíz del vértice de
-- a de menor raíz. Por ejemplo,
-- ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]
-- ghci> buscaActualiza (2,3) t
-- (True,Tbl [(1,1),(2,1),(3,1),(4,1)])
-- ghci> buscaActualiza (3,4) t
-- (False,Tbl [(1,1),(2,2),(3,1),(4,1)])
buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)
buscaActualiza (x,y) t
| x' == y' = (False, t)
| y' < x' = (True, modifica (x,y') t)
| otherwise = (True, modifica (y,x') t)
where x' = raiz t x
y' = raiz t y
-- 2ª solución (con el algoritmo de Prim)
-- ======================================
coste2 :: Int -> Int
coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]
-- (prim g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
-- λ> prim (grafoDivisibilidad 12)
-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim g = prim' [n] -- Nodos colocados
ns -- Nodos por colocar
[] -- Árbol de expansión
(aristas g) -- Aristas del grafo
where (n:ns) = nodos g
prim' t [] ae as = ae
prim' t r ae as = prim' (v':t) (delete v' r) (e:ae) as
where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
u `elem` t,
v `elem` r]
-- 3ª solución (con el algoritmo de Prim con conjuntos)
-- ====================================================
coste3 :: Int -> Int
coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]
-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
-- λ> prim2 (grafoDivisibilidad 12)
-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim2 g = prim2' (S.singleton n) -- Nodos colocados
(S.fromList ns) -- Nodos por colocar
[] -- Árbol de expansión
(aristas g) -- Aristas del grafo
where (n:ns) = nodos g
prim2' t r ae as
| S.null r = ae
| otherwise = prim2' (S.insert v' t)
(S.delete v' r)
(e:ae)
as
where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
S.member u t,
S.member v r]
-- 4ª solución
-- ===========
coste4 :: Int -> Int
coste4 n = sum [head (primeFactors x) | x <- [2..n]]
-- Comparación de eficiencia
-- =========================
-- λ> coste1 400
-- 14923
-- (0.08 secs, 31,336,440 bytes)
-- λ> coste2 400
-- 14923
-- (4.54 secs, 220,745,608 bytes)
-- λ> coste3 400
-- 14923
-- (0.69 secs, 217,031,144 bytes)
-- λ> coste4 400
-- 14923
-- (0.01 secs, 2,192,336 bytes)
--
-- λ> coste1 2000
-- 284105
-- (2.09 secs, 842,601,904 bytes)
-- λ> coste4 2000
-- 284105
-- (0.02 secs, 14,586,888 bytes) |
José A. Alonso
