El grafo de divisibilidad de orden n es el grafo cuyos nodos son los n\u00fameros naturales entre 1 y n, cuyas aristas son los pares (x,y) tales que x divide a y o y divide a x. El coste de cada arista es el cociente entre su mayor y menor elemento.<\/p>\n
Definir las siguientes funciones:<\/p>\n
\n grafoDivisibilidad :: Int -> Grafo Int Int\n coste :: Int -> Int\n<\/pre>\ntales que<\/p>\n
\n \u03bb> grafoDivisibilidad 12\n G ND (array (1,12)\n [(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),\n (8,8),(9,9),(10,10),(11,11),(12,12)]),\n (2,[(1,2),(4,2),(6,3),(8,4),(10,5),(12,6)]),\n (3,[(1,3),(6,2),(9,3),(12,4)]),\n (4,[(1,4),(2,2),(8,2),(12,3)]),\n (5,[(1,5),(10,2)]),\n (6,[(1,6),(2,3),(3,2),(12,2)]),\n (7,[(1,7)]),\n (8,[(1,8),(2,4),(4,2)]),\n (9,[(1,9),(3,3)]),\n (10,[(1,10),(2,5),(5,2)]),\n (11,[(1,11)]),\n (12,[(1,12),(2,6),(3,4),(4,3),(6,2)])])\n<\/pre>\n\n coste 12 == 41\n coste 3000 == 605305\n coste (2*10^5) == 1711798835\n<\/pre>\nSoluciones<\/h4>\n\nimport Data.Ix\nimport Data.List (delete, sort)\nimport qualified Data.Set as S\nimport I1M.Grafo\nimport I1M.Tabla\nimport Data.Numbers.Primes (primeFactors)\n\ngrafoDivisibilidad :: Int -> Grafo Int Int\ngrafoDivisibilidad n =\n creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]\n , x <- [1..y-1]\n , y `mod` x == 0]\n\n-- 1\u00aa soluci\u00f3n (con el algoritmo de Kruskal)\n-- =========================================\n\ncoste1 :: Int -> Int\ncoste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]\n\n-- (kruskal g) es el \u00e1rbol de expansi\u00f3n m\u00ednimo del grafo g calculado\n-- mediante el algoritmo de Kruskal. Por ejemplo,\n-- \u03bb> kruskal (grafoDivisibilidad 12)\n-- [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),\n-- (2,4,8),(2,3,6),(2,2,4),(2,1,2)]\nkruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]\nkruskal g = kruskal' cola -- Cola ordenada\n (tabla [(x,x) | x <- nodos g]) -- Tabla de raices\n [] -- \u00c1rbol de expansi\u00f3n\n (length (nodos g) - 1) -- Aristas por\n -- colocar\n where cola = sort [(p,x,y) | (x,y,p) <- aristas g]\n\nkruskal' ((p,x,y):as) t ae n \n | n == 0 = ae\n | actualizado = kruskal' as t' ((p,x,y):ae) (n-1)\n | otherwise = kruskal' as t ae n\n where (actualizado,t') = buscaActualiza (x,y) t\n\n-- (raiz t n) es la ra\u00edz de n en la tabla t. Por ejemplo,\n-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5 == 1\n-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2 == 6\nraiz:: Eq n => Tabla n n -> n -> n\nraiz t x | v == x = v\n | otherwise = raiz t v\n where v = valor t x\n\n-- (buscaActualiza a t) es el par formado por False y la tabla t, si los\n-- dos v\u00e9rtices de la arista a tienen la misma ra\u00edz en t y el par\n-- formado por True y la tabla obtenida a\u00f1adi\u00e9ndole a t la arista\n-- formada por el v\u00e9rtice de a de mayor ra\u00edz y la ra\u00edz del v\u00e9rtice de\n-- a de menor ra\u00edz. Por ejemplo,\n-- ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]\n-- ghci> buscaActualiza (2,3) t\n-- (True,Tbl [(1,1),(2,1),(3,1),(4,1)])\n-- ghci> buscaActualiza (3,4) t\n-- (False,Tbl [(1,1),(2,2),(3,1),(4,1)])\nbuscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)\nbuscaActualiza (x,y) t \n | x' == y' = (False, t) \n | y' < x' = (True, modifica (x,y') t)\n | otherwise = (True, modifica (y,x') t)\n where x' = raiz t x \n y' = raiz t y\n\n-- 2\u00aa soluci\u00f3n (con el algoritmo de Prim)\n-- ======================================\n\ncoste2 :: Int -> Int\ncoste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]\n\n-- (prim g) es el \u00e1rbol de expansi\u00f3n m\u00ednimo del grafo g calculado\n-- mediante el algoritmo de Prim. Por ejemplo,\n-- \u03bb> prim (grafoDivisibilidad 12)\n-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),\n-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]\nprim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]\nprim g = prim' [n] -- Nodos colocados\n ns -- Nodos por colocar \n [] -- \u00c1rbol de expansi\u00f3n\n (aristas g) -- Aristas del grafo\n where (n:ns) = nodos g\n\nprim' t [] ae as = ae\nprim' t r ae as = prim' (v':t) (delete v' r) (e:ae) as\n where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,\n u `elem` t, \n v `elem` r]\n\n-- 3\u00aa soluci\u00f3n (con el algoritmo de Prim con conjuntos)\n-- ====================================================\n\ncoste3 :: Int -> Int\ncoste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]\n\n-- (prim2 g) es el \u00e1rbol de expansi\u00f3n m\u00ednimo del grafo g calculado\n-- mediante el algoritmo de Prim. Por ejemplo,\n-- \u03bb> prim2 (grafoDivisibilidad 12)\n-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),\n-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]\nprim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]\nprim2 g = prim2' (S.singleton n) -- Nodos colocados\n (S.fromList ns) -- Nodos por colocar \n [] -- \u00c1rbol de expansi\u00f3n\n (aristas g) -- Aristas del grafo\n where (n:ns) = nodos g\n\nprim2' t r ae as\n | S.null r = ae\n | otherwise = prim2' (S.insert v' t)\n (S.delete v' r)\n (e:ae)\n as\n where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,\n S.member u t, \n S.member v r]\n\n-- 4\u00aa soluci\u00f3n\n-- ===========\n\ncoste4 :: Int -> Int\ncoste4 n = sum [head (primeFactors x) | x <- [2..n]]\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- \u03bb> coste1 400\n-- 14923\n-- (0.08 secs, 31,336,440 bytes)\n-- \u03bb> coste2 400\n-- 14923\n-- (4.54 secs, 220,745,608 bytes)\n-- \u03bb> coste3 400\n-- 14923\n-- (0.69 secs, 217,031,144 bytes)\n-- \u03bb> coste4 400\n-- 14923\n-- (0.01 secs, 2,192,336 bytes)\n-- \n-- \u03bb> coste1 2000\n-- 284105\n-- (2.09 secs, 842,601,904 bytes)\n-- \u03bb> coste4 2000\n-- 284105\n-- (0.02 secs, 14,586,888 bytes)\n<\/pre>\n","protected":false},"excerpt":{"rendered":"El grafo de divisibilidad de orden n es el grafo cuyos nodos son los n\u00fameros naturales entre 1 y n, cuyas aristas son los pares (x,y) tales que x divide a y o y divide a x. El coste de cada arista es el cociente entre su mayor y menor elemento. Definir las siguientes funciones:…<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"jetpack_post_was_ever_published":false,"_kad_post_transparent":"","_kad_post_title":"","_kad_post_layout":"","_kad_post_sidebar_id":"","_kad_post_content_style":"","_kad_post_vertical_padding":"","_kad_post_feature":"","_kad_post_feature_position":"","_kad_post_header":false,"_kad_post_footer":false,"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"footnotes":"","_jetpack_memberships_contains_paid_content":false},"categories":[4],"tags":[8,331,408,26,392,453,71,351,454,395,340,89,404,455,247,6,350,14,40],"jetpack_featured_media_url":"","jetpack_sharing_enabled":true,"_links":{"self":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/posts\/4072"}],"collection":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/comments?post=4072"}],"version-history":[{"count":3,"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/posts\/4072\/revisions"}],"predecessor-version":[{"id":4093,"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/posts\/4072\/revisions\/4093"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/media?parent=4072"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/categories?post=4072"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/exercitium\/wp-json\/wp\/v2\/tags?post=4072"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}