{"id":7660,"date":"2022-03-06T16:52:36","date_gmt":"2022-03-06T15:52:36","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=7660"},"modified":"2022-03-07T07:57:34","modified_gmt":"2022-03-07T06:57:34","slug":"la-semana-en-exercitium-del-28-de-febrero-al-4-de-marzo","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/la-semana-en-exercitium-del-28-de-febrero-al-4-de-marzo\/","title":{"rendered":"La semana en Exercitium (del 28 de febrero al 4 de marzo)"},"content":{"rendered":"<p>Esta semana he publicado en <a href=\"https:\/\/www.glc.us.es\/~jalonso\/exercitium\">Exercitium<\/a> las soluciones de los siguientes problemas:<\/p>\n<ul>\n<li><a href=\"#ej1\">1. Determinaci\u00f3n de los elementos minimales<\/a><\/li>\n<li><a href=\"#ej2\">2. Mastermind<\/a><\/li>\n<li><a href=\"#ej3\">3. Primos consecutivos con media capic\u00faa<\/a><\/li>\n<li><a href=\"#ej4\">4. Iguales al siguiente<\/a><\/li>\n<li><a href=\"#ej5\">5. Ordenaci\u00f3n por el m\u00e1ximo<\/a><\/li>\n<\/ul>\n<p>A continuaci\u00f3n se muestran las soluciones.<br \/>\n<!--more--><br \/>\n<a name=\"ej1\"><\/a><\/p>\n<h3>1. Determinaci\u00f3n de los elementos minimales<\/h3>\n<pre lang=\"haskell\">\n-- ---------------------------------------------------------------------\n-- Definir la funci\u00f3n\n--    minimales :: Ord a => [[a]] -> [[a]]\n-- tal que (minimales xss) es la lista de los elementos de xss que no\n-- est\u00e1n contenidos en otros elementos de xss. Por ejemplo,\n--    minimales [[1,3],[2,3,1],[3,2,5]]        ==  [[2,3,1],[3,2,5]]\n--    minimales [[1,3],[2,3,1],[3,2,5],[3,1]]  ==  [[2,3,1],[3,2,5]]\n--    map sum (minimales [[1..n] | n <- [1..300]])  ==  [45150]\n-- ---------------------------------------------------------------------\n\nmodule Elementos_minimales where\n\nimport Data.List (delete, nub)\nimport Test.QuickCheck (quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nminimales :: Ord a => [[a]] -> [[a]]\nminimales xss =\n  [xs | xs <- xss,\n        null [ys | ys <- xss, subconjuntoPropio xs ys]]\n\n-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio\n-- de ys. Por ejemplo,\n--    subconjuntoPropio [1,3] [3,1,3]    ==  False\n--    subconjuntoPropio [1,3,1] [3,1,2]  ==  True\nsubconjuntoPropio :: Ord a => [a] -> [a] -> Bool\nsubconjuntoPropio xs ys = aux (nub xs) (nub ys)\n  where\n    aux _       []  = False\n    aux []      _   = True\n    aux (u:us) vs = u `elem` vs && aux us (delete u vs)\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nminimales2 :: Ord a => [[a]] -> [[a]]\nminimales2 xss =\n  [xs | xs <- xss,\n        null [ys | ys <- xss, subconjuntoPropio2 xs ys]]\n\nsubconjuntoPropio2 :: Ord a => [a] -> [a] -> Bool\nsubconjuntoPropio2 xs ys =\n  subconjunto xs ys && not (subconjunto ys xs)\n\n-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por\n-- ejemplo,\n--    subconjunto [1,3] [3,1,3]        ==  True\n--    subconjunto [1,3,1,3] [3,1,3]    ==  True\n--    subconjunto [1,3,2,3] [3,1,3]    ==  False\n--    subconjunto [1,3,1,3] [3,1,3,2]  ==  True\nsubconjunto :: Ord a => [a] -> [a] -> Bool\nsubconjunto xs ys =\n  all (`elem` ys) xs\n\n-- Equivalencia de las definiciones\n-- ================================\n\n-- La propiedad es\nprop_minimales :: [[Int]] -> Bool\nprop_minimales xss =\n   minimales xss == minimales2 xss\n\nverifica_minimales :: IO ()\nverifica_minimales =\n  quickCheck prop_minimales\n\n-- La comprobaci\u00f3n es\n--    \u03bb> verifica_minimales\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> length (minimales [[1..n] | n <- [1..200]])\n--    1\n--    (2.30 secs, 657,839,560 bytes)\n--    \u03bb> length (minimales2 [[1..n] | n <- [1..200]])\n--    1\n--    (0.84 secs, 101,962,480 bytes)\n<\/pre>\n<p><a name=\"ej2\"><\/a><\/p>\n<h3>2. Mastermind<\/h3>\n<pre lang=\"haskell\">\n-- ---------------------------------------------------------------------\n-- El Mastermind es un juego que consiste en deducir un c\u00f3digo\n-- num\u00e9rico formado por una lista de n\u00fameros. Cada vez que se empieza\n-- una partida, el programa debe elegir un c\u00f3digo, que ser\u00e1 lo que el\n-- jugador debe adivinar en la menor cantidad de intentos posibles. Cada\n-- intento consiste en una propuesta de un c\u00f3digo posible que propone el\n-- jugador, y una respuesta del programa. Las respuestas le dar\u00e1n pistas\n-- al jugador para que pueda deducir el c\u00f3digo.\n--\n-- Estas pistas indican lo cerca que estuvo el n\u00famero propuesto de la\n-- soluci\u00f3n a trav\u00e9s de dos valores: la cantidad de aciertos es la\n-- cantidad de d\u00edgitos que propuso el jugador que tambi\u00e9n est\u00e1n en el\n-- c\u00f3digo en la misma posici\u00f3n. La cantidad de coincidencias es la\n-- cantidad de d\u00edgitos que propuso el jugador que tambi\u00e9n est\u00e1n en el\n-- c\u00f3digo pero en una posici\u00f3n distinta.\n--\n-- Por ejemplo, si el c\u00f3digo que eligi\u00f3 el programa es el [2,6,0,7] y\n-- el jugador propone el [1,4,0,6], el programa le debe responder un\n-- acierto (el 0, que est\u00e1 en el c\u00f3digo original en el mismo lugar, el\n-- tercero), y una coincidencia (el 6, que tambi\u00e9n est\u00e1 en el c\u00f3digo\n-- original, pero en la segunda posici\u00f3n, no en el cuarto como fue\n-- propuesto). Si el jugador hubiera propuesto el [3,5,9,1], habr\u00eda\n-- obtenido como respuesta ning\u00fan acierto y ninguna coincidencia, ya que\n-- no hay n\u00fameros en com\u00fan con el c\u00f3digo original. Si se obtienen\n-- cuatro aciertos es porque el jugador adivin\u00f3 el c\u00f3digo y gan\u00f3 el\n-- juego.\n--\n-- Definir la funci\u00f3n\n--    mastermind :: [Int] -> [Int] -> (Int,Int)\n-- tal que (mastermind xs ys) es el par formado por los n\u00fameros de\n-- aciertos y de coincidencias entre xs e ys. Por ejemplo,\n--    mastermind [3,3] [3,2]          ==  (1,0)\n--    mastermind [3,5,3] [3,2,5]      ==  (1,1)\n--    mastermind [3,5,3,2] [3,2,5,3]  ==  (1,3)\n--    mastermind [3,5,3,3] [3,2,5,3]  ==  (2,1)\n--    mastermind [1..10^6] [1..10^6]  ==  (1000000,0)\n-- ---------------------------------------------------------------------\n\nmodule Mastermind where\n\nimport qualified Data.Set as S\nimport Test.QuickCheck (quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nmastermind :: [Int] -> [Int] -> (Int, Int)\nmastermind xs ys =\n  (length (aciertos xs ys), length (coincidencias xs ys))\n\n-- (aciertos xs ys) es la lista de las posiciones de los aciertos entre\n-- xs e ys. Por ejemplo,\n--    aciertos [1,1,0,7] [1,0,1,7]  ==  [0,3]\naciertos :: Eq a => [a] -> [a] -> [Int]\naciertos xs ys =\n  [n | (n,x,y) <- zip3 [0..] xs ys, x == y]\n\n-- (coincidencia xs ys) es la lista de las posiciones de las\n-- coincidencias entre xs e ys. Por ejemplo,\n--    coincidencias [1,1,0,7] [1,0,1,7]  ==  [1,2]\ncoincidencias :: Eq a => [a] -> [a] -> [Int]\ncoincidencias xs ys =\n  [n | (n,y) <- zip [0..] ys,\n       y `elem` xs,\n       n `notElem` aciertos xs ys]\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nmastermind2 :: [Int] -> [Int] -> (Int, Int)\nmastermind2 xs ys =\n  (length aciertos2, length coincidencias2)\n  where\n    aciertos2, coincidencias2 :: [Int]\n    aciertos2      = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]\n    coincidencias2 = [n | (n,y) <- zip [0..] ys, y `elem` xs, n `notElem` aciertos2]\n\n-- 3\u00aa soluci\u00f3n\n-- ===========\n\nmastermind3 :: [Int] -> [Int] -> (Int, Int)\nmastermind3 xs ys = aux xs ys\n  where aux (u:us) (v:vs)\n          | u == v      = (a+1,b)\n          | v `elem` xs = (a,b+1)\n          | otherwise   = (a,b)\n          where (a,b) = aux us vs\n        aux _ _ = (0,0)\n\n-- 4\u00aa soluci\u00f3n\n-- ===========\n\nmastermind4 :: [Int] -> [Int] -> (Int, Int)\nmastermind4 xs ys =\n  (length aciertos4, length coincidencias4)\n  where\n    aciertos4, coincidencias4 :: [Int]\n    aciertos4      = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]\n    xs'            = S.fromList xs\n    coincidencias4 = [n | (n,y) <- zip [0..] ys, y `S.member` xs', n `notElem` aciertos4]\n\n-- Equivalencia de las definiciones\n-- ================================\n\n-- La propiedad es\nprop_mastermind :: [Int] -> [Int] -> Bool\nprop_mastermind xs ys =\n  all (== mastermind xs1 ys1)\n      [mastermind2 xs1 ys1,\n       mastermind3 xs1 ys1,\n       mastermind4 xs1 ys1]\n  where n   = min (length xs) (length ys)\n        xs1 = take n xs\n        ys1 = take n ys\n\nverifica_mastermind :: IO ()\nverifica_mastermind = quickCheck prop_mastermind\n\n-- La comprobaci\u00f3n es\n--    \u03bb> verifica_mastermind\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> mastermind [1..10^4] (map (*2) [1..10^4])\n--    (0,5000)\n--    (14.17 secs, 11,209,750,408 bytes)\n--    \u03bb> mastermind2 [1..10^4] (map (*2) [1..10^4])\n--    (0,5000)\n--    (0.83 secs, 8,190,200 bytes)\n--    \u03bb> mastermind3 [1..10^4] (map (*2) [1..10^4])\n--    (0,5000)\n--    (0.61 secs, 7,339,232 bytes)\n--    \u03bb> mastermind4 [1..10^4] (map (*2) [1..10^4])\n--    (0,5000)\n--    (0.03 secs, 8,910,128 bytes)\n<\/pre>\n<p><a name=\"ej3\"><\/a><\/p>\n<h3>3. Primos consecutivos con media capic\u00faa<\/h3>\n<pre lang=\"haskell\">\n-- ---------------------------------------------------------------------\n-- Definir la lista\n--    primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]\n-- formada por las ternas (x,y,z) tales que x e y son primos\n-- consecutivos cuya media, z, es capic\u00faa. Por ejemplo,\n--    \u03bb> take 5 primosConsecutivosConMediaCapicua\n--    [(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]\n--    \u03bb> primosConsecutivosConMediaCapicua !! 500\n--    (5687863,5687867,5687865)\n-- ---------------------------------------------------------------------\n\nmodule Primos_consecutivos_con_media_capicua where\n\nimport Data.List (genericTake)\nimport Data.Numbers.Primes (primes)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nprimosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]\nprimosConsecutivosConMediaCapicua =\n  [(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),\n             let z = (x + y) `div` 2,\n             capicua z]\n\n-- (primo x) se verifica si x es primo. Por ejemplo,\n--    primo 7  ==  True\n--    primo 8  ==  False\nprimo :: Integer -> Bool\nprimo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]\n\n-- primosImpares es la lista de los n\u00fameros primos impares. Por ejemplo,\n--    take 10 primosImpares  ==  [3,5,7,11,13,17,19,23,29]\nprimosImpares :: [Integer]\nprimosImpares = [x | x <- [3,5..], primo x]\n\n-- (capicua x) se verifica si x es capic\u00faa. Por ejemplo,\ncapicua :: Integer -> Bool\ncapicua x = ys == reverse ys\n  where ys = show x\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nprimosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]\nprimosConsecutivosConMediaCapicua2 =\n  [(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),\n             let z = (x + y) `div` 2,\n             capicua z]\n\nprimosImpares2 :: [Integer]\nprimosImpares2 = tail (criba [2..])\n  where criba (p:ps) = p : criba [n | n <- ps, mod n p \/= 0]\n\n-- 3\u00aa soluci\u00f3n\n-- ===========\n\nprimosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]\nprimosConsecutivosConMediaCapicua3 =\n  [(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),\n             let z = (x + y) `div` 2,\n             capicua z]\n\nprimos3 :: [Integer]\nprimos3 = 2 : 3 : criba3 0 (tail primos3) 3\n  where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],\n                                 and [n `rem` q \/= 0 | q <- take k (tail primos3)]]\n                            ++ criba3 (k+1) ps (p*p)\n\n-- 4\u00aa soluci\u00f3n\n-- ===========\n\nprimosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]\nprimosConsecutivosConMediaCapicua4 =\n  [(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),\n             let z = (x + y) `div` 2,\n             capicua z]\n\n-- Equivalencia de definiciones\n-- ============================\n\n-- La propiedad es\nprop_primosConsecutivosConMediaCapicua :: Integer -> Bool\nprop_primosConsecutivosConMediaCapicua n =\n  all (== genericTake n primosConsecutivosConMediaCapicua)\n      [genericTake n primosConsecutivosConMediaCapicua2,\n       genericTake n primosConsecutivosConMediaCapicua3,\n       genericTake n primosConsecutivosConMediaCapicua4]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> prop_primosConsecutivosConMediaCapicua 25\n--    True\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> primosConsecutivosConMediaCapicua !! 30\n--    (12919,12923,12921)\n--    (4.60 secs, 1,877,064,288 bytes)\n--    \u03bb> primosConsecutivosConMediaCapicua2 !! 30\n--    (12919,12923,12921)\n--    (0.69 secs, 407,055,848 bytes)\n--    \u03bb> primosConsecutivosConMediaCapicua3 !! 30\n--    (12919,12923,12921)\n--    (0.07 secs, 18,597,104 bytes)\n--    \u03bb> primosConsecutivosConMediaCapicua4 !! 30\n--    (12919,12923,12921)\n--    (0.01 secs, 10,065,784 bytes)\n--\n--    \u03bb> primosConsecutivosConMediaCapicua2 !! 40\n--    (29287,29297,29292)\n--    (2.67 secs, 1,775,554,576 bytes)\n--    \u03bb> primosConsecutivosConMediaCapicua3 !! 40\n--    (29287,29297,29292)\n--    (0.09 secs, 32,325,808 bytes)\n--    \u03bb> primosConsecutivosConMediaCapicua4 !! 40\n--    (29287,29297,29292)\n--    (0.01 secs, 22,160,072 bytes)\n--\n--    \u03bb> primosConsecutivosConMediaCapicua3 !! 150\n--    (605503,605509,605506)\n--    (3.68 secs, 2,298,403,864 bytes)\n--    \u03bb> primosConsecutivosConMediaCapicua4 !! 150\n--    (605503,605509,605506)\n--    (0.24 secs, 491,917,240 bytes)\n<\/pre>\n<p><a name=\"ej4\"><\/a><\/p>\n<h3>4. Iguales al siguiente<\/h3>\n<pre lang=\"haskell\">\n-- ---------------------------------------------------------------------\n-- Ejercicio. Definir la funci\u00f3n\n--    igualesAlSiguiente :: Eq a => [a] -> [a]\n-- tal que (igualesAlSiguiente xs) es la lista de los elementos de xs\n-- que son iguales a su siguiente. Por ejemplo,\n--    igualesAlSiguiente [1,2,2,2,3,3,4]  ==  [2,2,3]\n--    igualesAlSiguiente [1..10]          ==  []\n-- ---------------------------------------------------------------------\n\nmodule Iguales_al_siguiente where\n\nimport Data.List (group)\nimport Test.QuickCheck (quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente1 :: Eq a => [a] -> [a]\nigualesAlSiguiente1 xs =\n  [x | (x, y) <- consecutivos1 xs, x == y]\n\n-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en\n-- xs. Por ejemplo,\n--    consecutivos1 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]\nconsecutivos1 :: [a] -> [(a, a)]\nconsecutivos1 xs = zip xs (tail xs)\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente2 :: Eq a => [a] -> [a]\nigualesAlSiguiente2 xs =\n  [x | (x,y) <- consecutivos2 xs, x == y]\n\n-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en\n-- xs. Por ejemplo,\n--    consecutivos2 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]\nconsecutivos2 :: [a] -> [(a, a)]\nconsecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)\nconsecutivos2 _        = []\n\n-- 3\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente3 :: Eq a => [a] -> [a]\nigualesAlSiguiente3 (x:y:zs) | x == y    = x : igualesAlSiguiente3 (y:zs)\n                             | otherwise = igualesAlSiguiente3 (y:zs)\nigualesAlSiguiente3 _                    = []\n\n-- 4\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente4 :: Eq a => [a] -> [a]\nigualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]\n\n-- 5\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente5 :: Eq a => [a] -> [a]\nigualesAlSiguiente5 xs = concat (map tail (group xs))\n\n-- 6\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente6 :: Eq a => [a] -> [a]\nigualesAlSiguiente6 xs = tail =<< group xs\n\n-- 7\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente7 :: Eq a => [a] -> [a]\nigualesAlSiguiente7 = (tail =<<) . group\n\n-- 8\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente8 :: Eq a => [a] -> [a]\nigualesAlSiguiente8 xs = concatMap tail (group xs)\n\n-- 9\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente9 :: Eq a => [a] -> [a]\nigualesAlSiguiente9 = concatMap tail . group\n\n-- 10\u00aa soluci\u00f3n\n-- ===========\n\nigualesAlSiguiente10 :: Eq a => [a] -> [a]\nigualesAlSiguiente10 xs = aux xs (tail xs)\n  where aux (u:us) (v:vs) | u == v    = u : aux us vs\n                          | otherwise = aux us vs\n        aux _ _ = []\n\n-- Equivalencia de las definiciones\n-- ================================\n\n-- La propiedad es\nprop_igualesAlSiguiente :: [Int] -> Bool\nprop_igualesAlSiguiente xs =\n  all (== igualesAlSiguiente1 xs)\n      [igualesAlSiguiente2 xs,\n       igualesAlSiguiente3 xs,\n       igualesAlSiguiente4 xs,\n       igualesAlSiguiente5 xs,\n       igualesAlSiguiente6 xs,\n       igualesAlSiguiente7 xs,\n       igualesAlSiguiente8 xs,\n       igualesAlSiguiente9 xs,\n       igualesAlSiguiente10 xs]\n\nverificacion :: IO ()\nverificacion = quickCheck prop_igualesAlSiguiente\n\n-- La comprobaci\u00f3n es\n--    \u03bb> verificacion\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    > ej = concatMap show [1..10^6]\n--    (0.01 secs, 446,752 bytes)\n--    \u03bb> length ej\n--    5888896\n--    (0.16 secs, 669,787,856 bytes)\n--    \u03bb> length (show (igualesAlSiguiente1 ej))\n--    588895\n--    (1.60 secs, 886,142,944 bytes)\n--    \u03bb> length (show (igualesAlSiguiente2 ej))\n--    588895\n--    (1.95 secs, 1,734,143,816 bytes)\n--    \u03bb> length (show (igualesAlSiguiente3 ej))\n--    588895\n--    (1.81 secs, 1,178,232,104 bytes)\n--    \u03bb> length (show (igualesAlSiguiente4 ej))\n--    588895\n--    (1.43 secs, 1,932,010,304 bytes)\n--    \u03bb> length (show (igualesAlSiguiente5 ej))\n--    588895\n--    (0.40 secs, 2,016,810,320 bytes)\n--    \u03bb> length (show (igualesAlSiguiente6 ej))\n--    588895\n--    (0.32 secs, 1,550,409,984 bytes)\n--    \u03bb> length (show (igualesAlSiguiente7 ej))\n--    588895\n--    (0.34 secs, 1,550,410,104 bytes)\n--    \u03bb> length (show (igualesAlSiguiente8 ej))\n--    588895\n--    (0.33 secs, 1,550,410,024 bytes)\n--    \u03bb> length (show (igualesAlSiguiente9 ej))\n--    588895\n--    (0.33 secs, 1,550,450,968 bytes)\n--    \u03bb> length (show (igualesAlSiguiente10 ej))\n--    588895\n--    (1.54 secs, 754,272,600 bytes)\n<\/pre>\n<p><a name=\"ej5\"><\/a><\/p>\n<h3>5. Ordenaci\u00f3n por el m\u00e1ximo<\/h3>\n<pre lang=\"haskell\">\n-- ---------------------------------------------------------------------\n-- Definir la funci\u00f3n\n--    ordenadosPorMaximo :: Ord a => [[a]] -> [[a]]\n-- tal que (ordenadosPorMaximo xss) es la lista de los elementos de xss\n-- ordenada por sus m\u00e1ximos (se supone que los elementos de xss son\n-- listas no vac\u00eda) y cuando tiene el mismo m\u00e1ximo se conserva el orden\n-- original. Por ejemplo,\n--    \u03bb> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]\n--    [[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]\n--    \u03bb> ordenadosPorMaximo [\"este\",\"es\",\"el\",\"primero\"]\n--    [\"el\",\"primero\",\"es\",\"este\"]\n-- ---------------------------------------------------------------------\n\nmodule Ordenados_por_maximo where\n\nimport Data.List (sort, sortBy)\nimport GHC.Exts (sortWith)\nimport Test.QuickCheck (quickCheck)\n\n-- 1\u00aa soluci\u00f3n\nordenadosPorMaximo1 :: Ord a => [[a]] -> [[a]]\nordenadosPorMaximo1 xss =\n  map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])\n\n-- 2\u00aa soluci\u00f3n\nordenadosPorMaximo2 :: Ord a => [[a]] -> [[a]]\nordenadosPorMaximo2 xss =\n  [xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]\n\n-- 3\u00aa soluci\u00f3n\nordenadosPorMaximo3 :: Ord a => [[a]] -> [[a]]\nordenadosPorMaximo3 =\n  sortBy (\\xs ys -> compare (maximum xs) (maximum ys))\n\n-- 4\u00aa soluci\u00f3n\nordenadosPorMaximo4 :: Ord a => [[a]] -> [[a]]\nordenadosPorMaximo4 = sortWith maximum\n\n-- Equivalencia de las definiciones\n-- ================================\n\n-- La propiedad es\nprop_ordenadosPorMaximo :: [[Int]] -> Bool\nprop_ordenadosPorMaximo xss =\n  all (== ordenadosPorMaximo1 yss)\n      [ordenadosPorMaximo2 yss,\n       ordenadosPorMaximo3 yss,\n       ordenadosPorMaximo4 yss]\n  where yss = filter (not . null) xss\n\nverifica_ordenadosPorMaximo :: IO ()\nverifica_ordenadosPorMaximo =\n  quickCheck prop_ordenadosPorMaximo\n\n-- La comprobaci\u00f3n es\n--    \u03bb> verifica_ordenadosPorMaximo\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])\n--    10000\n--    (6.00 secs, 8,763,714,848 bytes)\n--    \u03bb> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])\n--    10000\n--    (6.15 secs, 8,764,177,472 bytes)\n--    \u03bb> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])\n--    10000\n--    (8.16 secs, 13,914,503,672 bytes)\n--    \u03bb> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])\n--    10000\n--    (7.77 secs, 13,914,183,776 bytes)\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>Esta semana he publicado en Exercitium las soluciones de los siguientes problemas: 1. Determinaci\u00f3n de los elementos minimales 2. Mastermind 3. Primos consecutivos con media capic\u00faa 4. Iguales al siguiente 5. Ordenaci\u00f3n por el m\u00e1ximo A continuaci\u00f3n se muestran las soluciones.<\/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":[337],"tags":[],"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\/7660"}],"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=7660"}],"version-history":[{"count":7,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7660\/revisions"}],"predecessor-version":[{"id":7667,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7660\/revisions\/7667"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=7660"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=7660"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=7660"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}