{"id":2038,"date":"2012-04-15T10:01:52","date_gmt":"2012-04-15T10:01:52","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=2038"},"modified":"2013-03-08T05:48:15","modified_gmt":"2013-03-08T05:48:15","slug":"sistemas-de-ternas-de-steiner-en-haskell","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/sistemas-de-ternas-de-steiner-en-haskell\/","title":{"rendered":"Sistemas de ternas de Steiner en Haskell"},"content":{"rendered":"

Un sistema de Steiner de ternas de orden \"n\", \"S(n)\", es un conjunto de ternas tal que los elementos de cada terna son n\u00fameros del \"1\" al \"n\" y cualquier par de elementos \"\{i,j\}\" (con \"\"1 \\leq i < j \\leq n[\/latex]) pertenece exactamente a una terna. Por ejemplo,\n[latex]S(3) = \\{\\{1,2,3\\}\\}[\/latex]\n[latex]S(7) = \\{\\{1,2,4\\}, \n \\{2,3,5\\}, \n \\{3,4,6\\}, \n \\{4,5,7\\}, \n \\{5,6,1\\}, \n \\{6,7,2\\}, \n \\{7,1,3\\}\\}[\/latex]\n\nSe verifica que [latex]S(n)[\/latex] es no vac\u00edo si, y s\u00f3lo si, si [latex]n[\/latex] es congruente con 1 o con 3 m\u00f3dulo 6. En ese caso, el n\u00famero de elementos de [latex]S(n)[\/latex] es [latex]\\frac{n(n-1)}{6}[\/latex]. \n\nEn la Wikipedia se encuentra m\u00e1s informaci\u00f3n sobre los sistemas de Steiner<\/a>.<\/p>\n

El objetivo de esta relaci\u00f3n es definir en Haskell una funci\u00f3n para calcular los sistemas de ternas de Steiner de orden n.
\n<\/p>\n

\r\n-- ---------------------------------------------------------------------\r\n-- \u00a7 Librer\u00edas auxiliares                                             --\r\n-- ---------------------------------------------------------------------\r\n\r\nimport Data.List\r\n\r\n-- ---------------------------------------------------------------------\r\n-- \u00a7 Reconocimiento de sistemas de Steiner                            --\r\n-- ---------------------------------------------------------------------\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 1. Definir los tipos sin\u00f3nimos Par y Terna para representar\r\n-- los pares y laa ternas de n\u00fameros enteros. \r\n-- ---------------------------------------------------------------------\r\n\r\ntype Par   = (Int,Int)\r\ntype Terna = (Int,Int,Int)\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Nota. En lo que sigue, cuando se usen pares y ternas, se supondr\u00e1 que\r\n-- sus elementos est\u00e1n ordenados de forma estrictamente creciente.\r\n-- ---------------------------------------------------------------------\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 2. Definir la funci\u00f3n\r\n--    pares:: Int -> [Par]\r\n-- tal que (pares n) es la lista de los subconjuntos de 2 elementos\r\n-- de {1,2,...,n}. Por ejemplo,\r\n--    pares 4  ==  [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]\r\n-- ---------------------------------------------------------------------\r\n\r\npares:: Int -> [Par]\r\npares n = [(x,y) | x <- [1..n], y <- [x+1..n]]\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 3. Definir la funci\u00f3n\r\n--    contenido :: Par -> Terna -> Bool\r\n-- tal que (contenido (p1,p2) (t1,t2,t3)) se verifica si {p1,p2} est\u00e1\r\n-- contenido en {t1,t2,t3}, suponiendo que p1 < p2 y t1 < t2 < t3. Por\r\n-- ejemplo,\r\n--    contenido (1,3) (1,3,5)  ==  True\r\n--    contenido (1,3) (1,2,3)  ==  True\r\n--    contenido (1,3) (1,2,4)  ==  False\r\n--    contenido (2,3) (1,2,3)  ==  True\r\n--    contenido (2,3) (1,2,4)  ==  False\r\n--    contenido (3,4) (1,2,3)  ==  False\r\n-- ---------------------------------------------------------------------\r\n\r\ncontenido :: Par -> Terna -> Bool\r\ncontenido (p1,p2) (t1,t2,t3)\r\n    | p1 == t1  = p2 == t2 || p2 == t3\r\n    | p1 == t2  = p2 == t3\r\n    | otherwise = False\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 4. Definir la funci\u00f3n\r\n--    parOcurreUnaVez :: Par -> [Terna] -> Bool\r\n-- tal que (parOcurreUnaVez p ts) se verifica si el par p est\u00e1 contenido \r\n-- exactamente en una de las ternas de ts. Por ejemplo,\r\n--    parOcurreUnaVez (1,3) [(1,2,4),(1,2,3)]  ==  True\r\n--    parOcurreUnaVez (1,3) [(1,2,4),(1,2,5)]  ==  False\r\n--    parOcurreUnaVez (1,3) [(1,3,4),(1,2,3)]  ==  False\r\n-- ---------------------------------------------------------------------\r\n\r\nparOcurreUnaVez :: Par -> [Terna] -> Bool\r\nparOcurreUnaVez p ts = length [1 | t <- ts, contenido p t] == 1\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 5. Definir la funci\u00f3n\r\n--    enRango :: Terna -> Int -> Bool\r\n-- tal que (enRango t n) se verifica si los elementos de la ternas t\r\n-- est\u00e1n entre 1 y n. Por ejemplo,\r\n--    enRango (1,3,6) 7  ==  True\r\n--    enRango (1,3,6) 5  ==  False\r\n-- ---------------------------------------------------------------------\r\n\r\nenRango :: Terna -> Int -> Bool\r\nenRango (t1,t2,t3) n = and [x `elem` [1..n] | x <- [t1,t2,t3]]\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 6. Definir la funci\u00f3n\r\n--    esSistemaSteiner :: [Terna] -> Int -> Bool\r\n-- tal que (esSistemaSteiner ts 7) se verifica si ts es un sistema de\r\n-- Steiner de orden n; es decir, ts es un conjunto de ternas en el rango\r\n-- n y para cualquier par de elementos {i,j} (con 1 <= i < j <= n)\r\n-- pertenece exactamente a una terna de ts. Por ejemplo,\r\n-- esSistemaSteiner [(3,5,6),(3,4,7),(2,5,7),(2,4,6),(1,6,7),(1,4,5),(1,2,3)] 7\r\n-- == True\r\n-- ---------------------------------------------------------------------\r\n\r\nesSistemaSteiner :: [Terna] -> Int -> Bool\r\nesSistemaSteiner ts n = \r\n    and [enRango t n | t <- ts] &&\r\n    and [parOcurreUnaVez p ts | p <- ps]\r\n    where ps = pares n\r\n\r\n-- ---------------------------------------------------------------------\r\n-- \u00a7 C\u00e1lculo de sistemas de Steiner                                   --\r\n-- ---------------------------------------------------------------------\r\n\r\n-- ---------------------------------------------------------------------\r\n-- El c\u00e1lculo de los sistemas de Steiner de orden n se basa en completar\r\n-- soluciones parciales. La soluciones parciales son pares de la forma\r\n-- (ps,ts) donde ps representa la lista de pares no cubiertos por las\r\n-- ternas de ts. Inicialmente, la soluci\u00f3n parcial es (pares n, []). En\r\n-- cada paso, se completa la soluci\u00f3n parcial (ps,ts) eligiendo el\r\n-- primer par (x,y) de ps y buscando los elementos z entre y+1 y n tales\r\n-- que (x,z) e (y,z) pertenecen a ps; las nuevas soluciones parciales\r\n-- son (ps',ts'), donde ps' se obtiene quitando a ps los pares (x,y), (x,z) e \r\n-- (y,z) y ts' se obtiene a\u00f1adiendo a ts la terna (x,y,z).\r\n-- ---------------------------------------------------------------------\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 7. Definir el sin\u00f3nimo de tipo SolPar como un par formado\r\n-- por una lista de pares y una lista de ternas.\r\n-- ---------------------------------------------------------------------\r\n    \r\ntype SolPar = ([Par],[Terna])\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 8. Definir la funci\u00f3n\r\n--    completableCon :: Par -> Int -> [Par] -> Bool \r\n-- tal que (completableCon (x,y) z ps) se verifica si el par (x,y) es\r\n-- completable con z respecto de ps; es decir, si (x,z) e (y,z) est\u00e1n en\r\n-- la lista de pares ps. Por ejemplo, \r\n--    completableCon (1,3) 5 [(1,5),(2,6),(3,5)]  ==  True\r\n--    completableCon (1,3) 5 [(1,5),(2,6),(3,7)]  ==  False\r\n-- ---------------------------------------------------------------------\r\n\r\ncompletableCon :: Par -> Int -> [Par] -> Bool \r\ncompletableCon (x,y) z ps = elem (x,z) ps && elem (y,z) ps\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 9. Definir la funci\u00f3n\r\n--    completacion :: Par -> Int -> SolPar -> SolPar\r\n-- tal que (completacion (x,y) z (ps,ts)) es el par (ps',ts') donde ps'\r\n-- es la lista de pares obtenida eliminando en ps los pares (x,z) e\r\n-- (y,z) y ts'es la lista de ternas obtenida a\u00f1adi\u00e9ndole a ts la terna\r\n-- (x,y,z). Por ejemplo,\r\n--    ghci> completacion (1,3) 4 ([(1,2),(1,4),(2,3),(3,4)],[(2,5,7)])\r\n--    ([(1,2),(2,3)],[(1,3,4),(2,5,7)])\r\n-- ---------------------------------------------------------------------\r\n\r\ncompletacion :: Par -> Int -> SolPar -> SolPar\r\ncompletacion (x,y) z (ps,ts) =\r\n    (ps \\\\ [(x,z),(y,z)], (x,y,z):ts)\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 10. Definir la funci\u00f3n\r\n--    completaciones :: SolPar -> Int -> [SolPar] \r\n-- tal que (completaciones (ps,ts) n) es la lista de las completaciones\r\n-- del primer elemento de ps con los elementos de {y+1, y+2, ..., n}\r\n-- respecto de (ps,ts). Por ejemplo, \r\n--    ghci> (pares 5, [])\r\n--    ([(1,2),(1,3),(1,4),(1,5),(2,3),(2,4),(2,5),(3,4),(3,5),(4,5)],[])\r\n--    ghci> completaciones it 5\r\n--    [([(1,4),(1,5),(2,4),(2,5),(3,4),(3,5),(4,5)],[(1,2,3)]),\r\n--     ([(1,3),(1,5),(2,3),(2,5),(3,4),(3,5),(4,5)],[(1,2,4)]),\r\n--     ([(1,3),(1,4),(2,3),(2,4),(3,4),(3,5),(4,5)],[(1,2,5)])]\r\n--    ghci> completaciones (head it) 5\r\n--    [([(2,4),(2,5),(3,4),(3,5)],[(1,4,5),(1,2,3)])]\r\n--    ghci> completaciones (head it) 5\r\n--    []\r\n-- ---------------------------------------------------------------------\r\n\r\ncompletaciones :: SolPar -> Int -> [SolPar] \r\ncompletaciones ((x,y):ps,ts) n =\r\n    [completacion (x,y) z (ps,ts) | \r\n     z <- [y+1..n],\r\n     completableCon (x,y) z ps]\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 11. Definir la funci\u00f3n\r\n--    sistemasSteiner :: Int -> [[Terna]]\r\n-- tal que (sistemasSteiner n) es el conjunto de los sistemas de Steiner\r\n-- de ternas de orden n. Por ejemplo,\r\n--    ghci> sistemasSteiner 3\r\n--    [[(1,2,3)]]\r\n--    ghci> sistemasSteiner 4\r\n--    []\r\n--    ghci> take 2 (sistemasSteiner 7)\r\n--    [[(5,6,7),(3,4,7),(2,4,6),(2,3,5),(1,4,5),(1,3,6),(1,2,7)],\r\n--     [(4,6,7),(3,5,7),(2,5,6),(2,3,4),(1,4,5),(1,3,6),(1,2,7)]]\r\n-- --------------------------------------------------------------------- \r\n\r\nsistemasSteiner :: Int -> [[Terna]]\r\nsistemasSteiner n = aux n [(pares n, [])] []\r\n    where\r\n      aux n [] tss              = tss\r\n      aux n (([],ts):lss) tss   = aux n lss (ts:tss)\r\n      aux n ((p:ps,ts):lss) tss =\r\n          aux n (completaciones (p:ps,ts) n ++ lss) tss\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 12. Definir la funci\u00f3n\r\n--    prop_correccion_Steiner :: Int -> Bool\r\n-- tal que (prop_correccion_Steiner n) se verifica si (sistemasSteiner n)\r\n-- es un sistema de Steiner de orden n. Comprobar la propiedad para n=7.\r\n-- ---------------------------------------------------------------------\r\n\r\nprop_correccion_Steiner :: Int -> Bool\r\nprop_correccion_Steiner n =\r\n    and [esSistemaSteiner ts n | ts <- sistemasSteiner n']\r\n    where n' = abs n\r\n\r\n-- La comprobaci\u00f3n es\r\n--    ghci> prop_correccion_Steiner 7\r\n--    True\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 13. Definir la funci\u00f3n\r\n--    steiner :: Int -> [Terna]\r\n-- tal que (steiner n) es un sistema de Steiner de ternas de orden\r\n-- n, usando el ejercicio anterior. Por ejemplo, \r\n--    ghci> steiner 7\r\n--    [(5,6,7),(3,4,7),(2,4,6),(2,3,5),(1,4,5),(1,3,6),(1,2,7)]\r\n-- ---------------------------------------------------------------------\r\n\r\nsteiner :: Int -> [Terna]\r\nsteiner = head . sistemasSteiner\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 14. Definir la funci\u00f3n\r\n--    steiner' :: Int -> [Terna]\r\n-- tal que (steiner' n) es un sistema de Steiner de ternas de orden\r\n-- n, que sea m\u00e1s eficiente que la del ejercicio anterior. Por ejemplo,\r\n--    ghci> steiner' 7\r\n--    [(3,5,6),(3,4,7),(2,5,7),(2,4,6),(1,6,7),(1,4,5),(1,2,3)]\r\n-- ---------------------------------------------------------------------\r\n\r\nsteiner' :: Int -> [Terna]\r\nsteiner' n = head (aux n [(pares n, [])] [])\r\n    where\r\n      aux n [] tss              = tss\r\n      aux n (([],ts):lss) tss   = [ts]\r\n      aux n ((p:ps,ts):lss) tss =\r\n          aux n (completaciones (p:ps,ts) n ++ lss) tss\r\n\r\n-- ---------------------------------------------------------------------\r\n-- Ejercicio 15. Comparar la eficiencia de steiner y steiner' comparando\r\n-- los tiempos empleados en calcular (steiner 9) y (steiner' 9).\r\n-- ---------------------------------------------------------------------\r\n\r\n-- La comparaci\u00f3n es\r\n--    ghci> steiner 9\r\n--    ...\r\n--    (0.28 secs, 13379652 bytes)\r\n--    ghci> steiner' 9\r\n--    ... \r\n--    (0.01 secs, 0 bytes)\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"
Un sistema de Steiner de ternas de orden , , es un conjunto de ternas tal que los elementos de cada terna son n\u00fameros del al y cualquier par de elementos (con 1 \\leq i < j \\leq n[\/latex]) pertenece exactamente a una terna. Por ejemplo, [latex]S(3) = \\{\\{1,2,3\\}\\}[\/latex] [latex]S(7) = \\{\\{1,2,4\\}, \\{2,3,5\\}, \\{3,4,6\\}, \\{4,5,7\\},...\n<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"closed","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":[1],"tags":[270],"jetpack_featured_media_url":"","jetpack_sharing_enabled":true,"jetpack_likes_enabled":false,"_links":{"self":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/2038"}],"collection":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/comments?post=2038"}],"version-history":[{"count":6,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/2038\/revisions"}],"predecessor-version":[{"id":2820,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/2038\/revisions\/2820"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=2038"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=2038"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=2038"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}