{"id":7762,"date":"2022-07-23T11:52:40","date_gmt":"2022-07-23T09:52:40","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=7762"},"modified":"2022-07-23T11:52:40","modified_gmt":"2022-07-23T09:52:40","slug":"pfh-la-semana-en-exercitium-22-de-julio-de-2022","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/pfh-la-semana-en-exercitium-22-de-julio-de-2022\/","title":{"rendered":"PFH: La semana en Exercitium (22 de julio de 2022)"},"content":{"rendered":"<p>Esta semana he publicado en <a href=\"http:\/\/bit.ly\/2sqPtGs\">Exercitium<\/a> las soluciones de los siguientes problemas:<\/p>\n<ul>\n<li><a href=\"#ej1\">1. Primos con cubos<\/a><\/li>\n<li><a href=\"#ej2\">2. Sumas alternas de factoriales<\/a><\/li>\n<li><a href=\"#ej3\">3. Potencias perfectas<\/a><\/li>\n<li><a href=\"#ej4\">4. Sucesi\u00f3n de suma de cuadrados de los d\u00edgitos<\/a><\/li>\n<li><a href=\"#ej5\">5. La funci\u00f3n indicatriz de Euler<\/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. Primos con cubos<\/h3>\n<p>Un <strong>primo con cubo<\/strong> es un n\u00famero primo p para el que existe alg\u00fan entero positivo n tal que la expresi\u00f3n n^3 + n^2p es un cubo perfecto. Por ejemplo, 19 es un primo con cubo ya que  8^3 + 8^2\u00d719 = 12^3.<\/p>\n<p>Definir la sucesi\u00f3n<\/p>\n<pre lang=\"text\">\n   primosConCubos :: [Integer]\n<\/pre>\n<p>tal que sus elementos son los primos con cubo. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   \u03bb> take 6 primosConCubos\n   [7,19,37,61,127,271]\n   \u03bb> length (takeWhile (< 1000000) primosConCubos)\n   173\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.Numbers.Primes (isPrime)\nimport Test.QuickCheck (NonNegative (NonNegative), maxSize, quickCheckWith, stdArgs) \n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nprimosConCubos1 :: [Integer]\nprimosConCubos1 =\n  [p | x <- [1..],\n       n <- [1..x],\n       (x^3 - n^3) `mod` (n^2) == 0,\n       let p = (x^3 - n^3) `div` (n^2),\n       isPrime p]\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\n-- Para analizar la respuesta, en esta soluci\u00f3n se calculan los pares\n-- (p,n) tales que p es un primo con cubo y n es un n\u00famero positivo tal\n-- que n^3 + n^2p es un cubo\n\nprimosConCubos2' :: [(Integer,Integer)]\nprimosConCubos2' =\n  [(p,n) | x <- [1..],\n           n <- [1..x],\n           (x^3 - n^3) `mod` (n^2) == 0,\n           let p = (x^3 - n^3) `div` (n^2),\n           isPrime p]\n\n-- El c\u00e1lculo es\n--    \u03bb> take 7 primosConCubos2\n--    [(7,1),(19,8),(37,27),(61,64),(127,216),(271,729),(331,1000)]\n\n-- Se observa que la sucesi\u00f3n de los segundos elementos [1,8,27,64,...]\n-- es la de los cubos y que los primeros elementos se obtienen restando\n-- los segundos elementos consecutivos; es decir,\n--     7 =  8 -  1 = 2^3 - 1^3  \n--    19 = 27 -  8 = 3^3 - 2^3\n--    37 = 64 - 27 = 4^3 - 3^3\n-- Continuando el patr\u00f3n,\n--     61 =  5^3 - 4^3 =  125 -   64\n--     91 =  6^3 - 5^3 =  216 -  125\n--    127 =  7^3 - 6^3 =  343 -  216\n--    271 = 10^3 - 9^3 = 1000 -  729\n--    331 = 11^3 -10^3 = 1331 - 1000\n-- Por tanto, los primos con cubos son diferencias de dos cubos\n-- consecutivos; es decir, coinciden con los n\u00fameros cubanos del\n-- ejercicio anterior. A partir de la conjetura se obtienen las\n-- siguientes definiciones\n\n-- Basado en las anteriores observaciones se obtiene la siguiente\n-- definici\u00f3n \nprimosConCubos2 :: [Integer]\nprimosConCubos2 = \n  filter isPrime [(x+1)^3 - x^3 | x <- [1..]] \n\n-- 3\u00aa definici\u00f3n\n-- =============\n\nprimosConCubos3 :: [Integer]\nprimosConCubos3 =\n  filter isPrime diferenciasCubosConsecutivos\n\ndiferenciasCubosConsecutivos :: [Integer]\ndiferenciasCubosConsecutivos =\n  zipWith (-) (tail cubos) cubos \n\ncubos :: [Integer]\ncubos = map (^3) [0..]\n\n-- 4\u00aa soluci\u00f3n\n-- ===========\n\n-- Simplificando la expresi\u00f3n (x+1)^3 - x^3 se obtiene 3*x^2+ 3*x + 1,\n-- con lo que la 3\u00aa definici\u00f3n se reduce a\n\nprimosConCubos4 :: [Integer]\nprimosConCubos4 =\n  [p | x <- [1..],\n       let p = 3*x^2+ 3*x + 1,\n       isPrime p]\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_primosConCubos :: NonNegative Int -> Bool\nprop_primosConCubos (NonNegative n) =\n  all (== primosConCubos1 !! n)\n      [primosConCubos2 !! n,\n       primosConCubos3 !! n,\n       primosConCubos4 !! n]\n  \n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheckWith (stdArgs {maxSize=10}) prop_primosConCubos\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> primosConCubos1 !! 6\n--    331\n--    (1.15 secs, 1,105,612,336 bytes)\n--    \u03bb> primosConCubos1 !! 7\n--    397\n--    (1.96 secs, 1,909,369,592 bytes)\n--    \u03bb> primosConCubos2 !! 7\n--    397\n--    \n--    (0.01 secs, 648,840 bytes)\n--    \u03bb> primosConCubos2 !! (10^3)\n--    65580901\n--    (0.53 secs, 1,726,837,688 bytes)\n--    \u03bb> primosConCubos3 !! (10^3)\n--    65580901\n--    (0.49 secs, 1,724,258,632 bytes)\n--    \u03bb> primosConCubos4 !! (10^3)\n--    65580901\n--    (0.47 secs, 1,724,833,992 bytes)\n\n-- Demostraci\u00f3n de la conjetura\n-- ============================\n\n-- Vamos a demostrar que los primos con cubos son diferencias de dos\n-- cubos consecutivos.\n--\n-- Sea p un primo con cubo. Por la definici\u00f3n, existe un entero\n-- positivo n tal que n\u00b3 + n\u00b2p es un cubo. \n--\n-- Lema 1: Los n\u00fameros n y p son coprimos (es decir, mcd(n,p) = 1).\n-- Dem.: En caso contrario, puesto que p es primo, existe un a tal que \n-- n = ap. Luego n\u00b3 + n\u00b2p = (a\u00b3+a\u00b2)p\u00b3 es un cubo y, por tanto,\n-- a\u00b3+a\u00b2 es un cubo lo que es imposible ya que el siguiente cubo de\n-- a\u00b3 es a\u00b3+3a\u00b2+3a+1.\n--\n-- Lema 2: Los n\u00fameros n\u00b2 y n+p son coprimos.\n-- Dem.: Sea k = mcd(n^2,n+p). Por k divide n\u00b2, luego k divide a n;\n-- adem\u00e1s, k divide a n+p y (usando el lema 1 y el ser p primo), se\n-- tiene que k = 1.\n--\n-- Puesto que n\u00b3+n\u00b2p = n\u00b2(n+p) es un cubo, usando el lema 2, se tiene\n-- que n\u00b2 y n+p son cubos y, por serlo n\u00b2, n tambi\u00e9n es un cubo. Es\n-- decir, existen enteros positivos x e y tales que n = x\u00b3 y \n-- n+p = y\u00b3. Por tanto, p = y\u00b3-x\u00b3. Sea k = y-x. Se tiene que k = 1 ya\n-- que \n--    p = y\u00b3-x\u00b3\n--      = (n+k)\u00b3-n\u00b3\n--      = 3k+3k\u00b2+k\u00b3\n-- no es primo para k > 1.\n--\n-- Por consiguiente, p = (x+1)\u00b3-x\u00b3.\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Primos_con_cubos.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej2\"><\/a><\/p>\n<h3>2. Sumas alternas de factoriales<\/h3>\n<p>Las primeras sumas alternas de los factoriales son n\u00fameros primos; en efecto,<\/p>\n<pre lang=\"text\">\n   3! - 2! + 1! = 5\n   4! - 3! + 2! - 1! = 19\n   5! - 4! + 3! - 2! + 1! = 101\n   6! - 5! + 4! - 3! + 2! - 1! = 619\n   7! - 6! + 5! - 4! + 3! - 2! + 1! = 4421\n   8! - 7! + 6! - 5! + 4! - 3! + 2! - 1! = 35899\n<\/pre>\n<p>son primos, pero<\/p>\n<pre lang=\"text\">\n   9! - 8! + 7! - 6! + 5! - 4! + 3! - 2! + 1! = 326981\n<\/pre>\n<p>no es primo.<\/p>\n<p>Definir las funciones<\/p>\n<pre lang=\"text\">\n   sumaAlterna         :: Integer -> Integer\n   sumasAlternas       :: [Integer]\n   conSumaAlternaPrima :: [Integer]\n<\/pre>\n<p>tales que<\/p>\n<ul>\n<li>(sumaAlterna n) es la suma alterna de los factoriales desde n hasta 1. Por ejemplo,<\/li>\n<\/ul>\n<pre lang=\"text\">\n     sumaAlterna 3  ==  5\n     sumaAlterna 4  ==  19\n     sumaAlterna 5  ==  101\n     sumaAlterna 6  ==  619\n     sumaAlterna 7  ==  4421\n     sumaAlterna 8  ==  35899\n     sumaAlterna 9  ==  326981\n     sumaAlterna (5*10^4) `mod` (10^6) == 577019\n<\/pre>\n<ul>\n<li>sumasAlternas es la sucesi\u00f3n de las sumas alternas de factoriales. Por ejemplo, <\/li>\n<\/ul>\n<pre lang=\"text\">\n     \u03bb> take 10 sumasAlternas1\n     [0,1,1,5,19,101,619,4421,35899,326981]\n<\/pre>\n<ul>\n<li>conSumaAlternaPrima es la sucesi\u00f3n de los n\u00fameros cuya suma alterna de factoriales es prima. Por ejemplo, <\/li>\n<\/ul>\n<pre lang=\"text\">\n     \u03bb> take 8 conSumaAlternaPrima\n     [3,4,5,6,7,8,10,15]\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.List (genericTake)\nimport Data.Numbers.Primes (isPrime)\nimport Test.QuickCheck\n\n-- 1\u00aa definici\u00f3n de sumaAlterna\n-- ============================\n\nsumaAlterna1 :: Integer -> Integer\nsumaAlterna1 1 = 1\nsumaAlterna1 n = factorial n - sumaAlterna1 (n-1)\n\nfactorial :: Integer -> Integer\nfactorial n = product [1..n]\n\n-- 2\u00aa definici\u00f3n de sumaAlterna\n-- ============================\n\nsumaAlterna2 :: Integer -> Integer\nsumaAlterna2 n =\n  sum (genericTake n (zipWith (*) signos (tail factoriales)))\n  where\n    signos | odd n     = concat (repeat [1,-1])\n           | otherwise = concat (repeat [-1,1])\n\n-- factoriales es la lista de los factoriales. Por ejemplo,\n--    take 7 factoriales  ==  [1,1,2,6,24,120,720]\nfactoriales :: [Integer]\nfactoriales = 1 : scanl1 (*) [1..]\n\n-- 3\u00aa definici\u00f3n de sumaAlterna\n-- ============================\n\nsumaAlterna3 :: Integer -> Integer\nsumaAlterna3 n = \n  sum (genericTake n (zipWith (*) signos (tail factoriales)))\n  where signos | odd n     = cycle [1,-1]\n               | otherwise = cycle [-1,1]\n\n-- 3\u00aa definici\u00f3n de sumaAlterna\n-- ============================\n\nsumaAlterna4 :: Integer -> Integer\nsumaAlterna4 n =\n  foldl (flip (-)) 0 (scanl1 (*) [1..n])\n\n-- Comprobaci\u00f3n de equivalencia de sumaAlterna\n-- ===========================================\n\n-- La propiedad es\nprop_sumaAlterna :: Positive Integer -> Bool \nprop_sumaAlterna (Positive n) =\n  all (== sumaAlterna1 n)\n      [sumaAlterna2 n,\n       sumaAlterna3 n,\n       sumaAlterna4 n]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_sumaAlterna\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia de sumaAlterna \n-- ========================================\n\n-- La comparaci\u00f3n es\n--    \u03bb> sumaAlterna1 4000 `mod` (10^6)\n--    577019\n--    (6.21 secs, 16,154,113,192 bytes)\n--    \u03bb> sumaAlterna2 4000 `mod` (10^6)\n--    577019\n--    (0.01 secs, 24,844,664 bytes)\n--    \n--    \u03bb> sumaAlterna2 (5*10^4) `mod` (10^6)\n--    577019\n--    (1.81 secs, 4,729,583,864 bytes)\n--    \u03bb> sumaAlterna3 (5*10^4) `mod` (10^6)\n--    577019\n--    (0.89 secs, 4,725,983,928 bytes)\n--    \u03bb> sumaAlterna4 (5*10^4) `mod` (10^6)\n--    577019\n--    (0.70 secs, 4,710,770,592 bytes)\n\n-- En lo que sigue se usa la 3\u00aa definici\u00f3n\nsumaAlterna :: Integer -> Integer\nsumaAlterna = sumaAlterna3\n\n-- 1\u00aa definici\u00f3n de sumasAlternas\n-- ==============================\n\nsumasAlternas1 :: [Integer]\nsumasAlternas1 =\n  map sumaAlterna [0..]\n\n-- 2\u00aa definici\u00f3n de sumasAlternas\n-- ==============================\n\nsumasAlternas2 :: [Integer]\nsumasAlternas2 =\n  0 : zipWith (-) (tail factoriales) sumasAlternas2\n\n-- 3\u00aa definici\u00f3n de sumasAlternas\n-- ==============================\n\nsumasAlternas3 :: [Integer]\nsumasAlternas3 =\n  scanl (flip (-)) 0 $ scanl1 (*) [1..]\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_sumasAlternas :: NonNegative Int -> Bool\nprop_sumasAlternas (NonNegative n) =\n  all (== sumasAlternas1 !! n)\n      [sumasAlternas2 !! n,\n       sumasAlternas3 !! n]\n  \n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_sumasAlternas\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> length (show (sumasAlternas1 !! (5*10^4)))\n--    213237\n--    (4.90 secs, 4,731,620,600 bytes)\n--    \u03bb> length (show (sumasAlternas2 !! (5*10^4)))\n--    213237\n--    (2.39 secs, 4,726,820,456 bytes)\n--    \u03bb> length (show (sumasAlternas3 !! (5*10^4)))\n--    213237\n--    (1.78 secs, 4,726,820,280 bytes)\n\n-- 1\u00aa definici\u00f3n de conSumaAlternaPrima\n-- ====================================\n\nconSumaAlternaPrima1 :: [Integer]\nconSumaAlternaPrima1 =\n  [n | n <- [0..], isPrime (sumaAlterna n)]\n\n-- 2\u00aa definici\u00f3n de conSumaAlternaPrima\n-- ====================================\n\nconSumaAlternaPrima2 :: [Integer]\nconSumaAlternaPrima2 =\n  [x | (x,y) <- zip [0..] sumasAlternas2, isPrime y]\n\n-- 3\u00aa definici\u00f3n de conSumaAlternaPrima\n-- ====================================\n\nconSumaAlternaPrima3 :: [Integer]\nconSumaAlternaPrima3 =\n  filter (isPrime . sumaAlterna) [0..]\n\n-- Comprobaci\u00f3n de equivalencia de conSumaAlternaPrima\n-- ===================================================\n\n-- La propiedad es\nprop_conSumaAlternaPrima :: NonNegative Int -> Bool\nprop_conSumaAlternaPrima (NonNegative n) =\n  all (== conSumaAlternaPrima1 !! n)\n      [conSumaAlternaPrima2 !! n,\n       conSumaAlternaPrima3 !! n]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheckWith (stdArgs {maxSize=5}) prop_conSumaAlternaPrima\n--    +++ OK, passed 100 tests.\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Suma_alterna_de_factoriales.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej3\"><\/a><\/p>\n<h3>3. Potencias perfectas<\/h3>\n<p>Un n\u00famero natural n es una <strong>potencia perfecta<\/strong> si existen dos n\u00fameros naturales m > 1 y k > 1 tales que n = m^k. Las primeras potencias perfectas son<\/p>\n<pre lang=\"text\">\n   4 = 2\u00b2, 8 = 2\u00b3, 9 = 3\u00b2, 16 = 2\u2074, 25 = 5\u00b2, 27 = 3\u00b3, 32 = 2\u2075, \n   36 = 6\u00b2, 49 = 7\u00b2, 64 = 2\u2076, ...\n<\/pre>\n<p>Definir la sucesi\u00f3n<\/p>\n<pre lang=\"text\">\n   potenciasPerfectas :: [Integer]\n<\/pre>\n<p>cuyos t\u00e9rminos son las potencias perfectas. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   take 10 potenciasPerfectas  ==  [4,8,9,16,25,27,32,36,49,64]\n   potenciasPerfectas !! 3000  ==  7778521\n<\/pre>\n<p>Definir el procedimiento<\/p>\n<pre lang=\"text\">\n   grafica :: Int -> IO ()\n<\/pre>\n<p>tal que (grafica n) es la representaci\u00f3n gr\u00e1fica de las n primeras potencias perfectas. Por ejemplo, para (grafica 30) dibuja<br \/>\n<a href=\"https:\/\/i0.wp.com\/www.glc.us.es\/~jalonso\/exercitium\/wp-content\/uploads\/2017\/03\/Potencias_perfectas.png\"><img loading=\"lazy\" decoding=\"async\" src=\"https:\/\/i0.wp.com\/www.glc.us.es\/~jalonso\/exercitium\/wp-content\/uploads\/2017\/03\/Potencias_perfectas.png?resize=624%2C373\" alt=\"\" width=\"624\" height=\"373\" class=\"aligncenter size-full wp-image-3159\" data-recalc-dims=\"1\" \/><\/a><\/p>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.List (group)\nimport Data.Numbers.Primes (primeFactors)\nimport Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)\nimport Test.QuickCheck (NonNegative (NonNegative), quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\npotenciasPerfectas1 :: [Integer]\npotenciasPerfectas1 = filter esPotenciaPerfecta [4..]\n\n-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por\n-- ejemplo, \n--    esPotenciaPerfecta 36  ==  True\n--    esPotenciaPerfecta 72  ==  False\nesPotenciaPerfecta :: Integer -> Bool\nesPotenciaPerfecta = not . null. potenciasPerfectasDe \n\n-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que \n-- x = a^b. Por ejemplo,\n--    potenciasPerfectasDe 64  ==  [(2,6),(4,3),(8,2)]\n--    potenciasPerfectasDe 72  ==  []\npotenciasPerfectasDe :: Integer -> [(Integer,Integer)]\npotenciasPerfectasDe n = \n  [(m,k) | m <- takeWhile (\\x -> x*x <= n) [2..]\n         , k <- takeWhile (\\x -> m^x <= n) [2..]\n         , m^k == n]\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\npotenciasPerfectas2 :: [Integer]\npotenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]\n\n-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por\n-- ejemplo, \n--    esPotenciaPerfecta2 36  ==  True\n--    esPotenciaPerfecta2 72  ==  False\nesPotenciaPerfecta2 :: Integer -> Bool\nesPotenciaPerfecta2 x = mcd (exponentes x) > 1\n\n-- (exponentes x) es la lista de los exponentes de l factorizaci\u00f3n prima\n-- de x. Por ejemplos,\n--    exponentes 36  ==  [2,2]\n--    exponentes 72  ==  [3,2]\nexponentes :: Integer -> [Int]\nexponentes x = [length ys | ys <- group (primeFactors x)] \n\n-- (mcd xs) es el m\u00e1ximo com\u00fan divisor de la lista xs. Por ejemplo,\n--    mcd [4,6,10]  ==  2\n--    mcd [4,5,10]  ==  1\nmcd :: [Int] -> Int\nmcd = foldl1 gcd\n\n-- 3\u00aa soluci\u00f3n\n-- ===========\n\npotenciasPerfectas3 :: [Integer]\npotenciasPerfectas3 = mezclaTodas potencias\n\n-- potencias es la lista las listas de potencias de todos los n\u00fameros\n-- mayores que 1 con exponentes mayores que 1. Por ejemplo,\n--    \u03bb> map (take 3) (take 4 potencias)\n--    [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]\npotencias:: [[Integer]]\npotencias = [[n^k | k <- [2..]] | n <- [2..]]\n\n-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las\n-- listas ordenadas xss. Por ejemplo,\n--    take 7 (mezclaTodas potencias)  ==  [4,8,9,16,25,27,32]\nmezclaTodas :: Ord a => [[a]] -> [a]\nmezclaTodas = foldr1 xmezcla\n  where xmezcla (x:xs) ys = x : mezcla xs ys\n\n-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las\n-- listas ordenadas xs e ys. Por ejemplo,\n--    take 7 (mezcla [2,5..] [4,6..])  ==  [2,4,5,6,8,10,11]\nmezcla :: Ord a => [a] -> [a] -> [a]\nmezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)\n                     | x == y = x : mezcla xs ys\n                     | x > y  = y : mezcla (x:xs) ys\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_potenciasPerfectas :: NonNegative Int -> Bool\nprop_potenciasPerfectas (NonNegative n) =\n  all (== potenciasPerfectas1 !! n)\n      [potenciasPerfectas2 !! n,\n       potenciasPerfectas3 !! n]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_potenciasPerfectas\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> potenciasPerfectas1 !! 200\n--    28224\n--    (10.56 secs, 8,434,647,368 bytes)\n--    \u03bb> potenciasPerfectas2 !! 200\n--    28224\n--    (0.36 secs, 825,040,416 bytes)\n--    \u03bb> potenciasPerfectas3 !! 200\n--    28224\n--    (0.05 secs, 7,474,280 bytes)\n--    \n--    \u03bb> potenciasPerfectas2 !! 500\n--    191844\n--    (4.16 secs, 9,899,367,112 bytes)\n--    \u03bb> potenciasPerfectas3 !! 500\n--    191844\n--    (0.09 secs, 51,275,464 bytes)\n\n-- En lo que sigue se usa la 3\u00aa soluci\u00f3n\npotenciasPerfectas :: [Integer]\npotenciasPerfectas = potenciasPerfectas3\n\n-- Representaci\u00f3n gr\u00e1fica\n-- ======================\n\ngrafica :: Int -> IO ()\ngrafica n = \n  plotList [ Key Nothing\n           , PNG \"Potencias_perfectas.png\"\n           ]\n           (take n potenciasPerfectas)\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Potencias_perfectas.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej4\"><\/a><\/p>\n<h3>4. Sucesi\u00f3n de suma de cuadrados de los d\u00edgitos<\/h3>\n<p>Definir la funci\u00f3n<\/p>\n<pre lang=\"text\">\n   sucSumaCuadradosDigitos :: Integer -> [Integer]\n<\/pre>\n<p>tal que (sucSumaCuadradosDigitos n) es la sucesi\u00f3n cuyo primer t\u00e9rmino es n y los restantes se obtienen sumando los cuadrados de los d\u00edgitos de su t\u00e9rmino anterior. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   \u03bb> take 20 (sucSumaCuadradosDigitos1 2000)\n   [2000,4,16,37,58,89,145,42,20,4,16,37,58,89,145,42,20,4,16,37]\n   \u03bb> take 20 (sucSumaCuadradosDigitos 1976)\n   [1976,167,86,100,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]\n   \u03bb> sucSumaCuadradosDigitos 2000 !! (10^9)\n   20\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Test.QuickCheck (Positive (Positive), NonNegative (NonNegative), quickCheck)\n\n-- 1\u00aa soluci\u00f3n \n-- ===========\n\nsucSumaCuadradosDigitos1 :: Integer -> [Integer]\nsucSumaCuadradosDigitos1 n =\n  n : [sumaCuadradosDigitos x | x <- sucSumaCuadradosDigitos1 n]\n\n-- (sumaCuadradosDigitos n) es la suma de los cuadrados de los d\u00edgitos\n-- de n. Por ejemplo, \n--    sumaCuadradosDigitos 2016  ==  41\nsumaCuadradosDigitos :: Integer -> Integer\nsumaCuadradosDigitos n = sum (map (^2) (digitos n))\n\n-- (digitos n) es la lista de los d\u00edgitos de n. Por ejemplo,\n--    digitos 325  ==  [3,2,5]\ndigitos :: Integer -> [Integer]\ndigitos n = [read [d] | d <- show n]\n\n-- 2\u00aa soluci\u00f3n \n-- ===========\n\nsucSumaCuadradosDigitos2 :: Integer -> [Integer]\nsucSumaCuadradosDigitos2 = iterate sumaCuadradosDigitos\n\n-- 3\u00aa soluci\u00f3n\n-- ===========\n\n-- A partir de los c\u00e1lculos con las definiciones anteriores, se observa\n-- que para todo n (sucSumaCuadradosDigitos n) tiene una parte pura y\n-- otra peri\u00f3dica. Por ejemplo, para n = 2016, \n--    \u03bb> take 20 (sucSumaCuadradosDigitos 2016)\n--    [2016,41,17,50,25,29,85,89,145,42,20,4,16,37,58,89,145,42,20,4]\n-- la parte pura es\n--    [2016,41,17,50,25,29,85]\n-- y la parte peri\u00f3dica es\n--    [89,145,42,20,4,16,37,58])\n\nsucSumaCuadradosDigitos3 :: Integer -> [Integer]\nsucSumaCuadradosDigitos3 n = xs ++ cycle ys\n  where (xs,ys) = sucCompactaSumaCuadradosDigitos n\n\n-- (sucCompactaSumaCuadradosDigitos n) es el par formado por la parte\n-- pura y la peri\u00f3dica de (sucSumaCuadradosDigitos n). Por ejemplo, \n--    \u03bb> sucCompactaSumaCuadradosDigitos 2016\n--    ([2016,41,17,50,25,29,85],[89,145,42,20,4,16,37,58])\n--    \u03bb> sucCompactaSumaCuadradosDigitos 1976\n--    ([1976,167,86,100],[1])\nsucCompactaSumaCuadradosDigitos :: Integer -> ([Integer],[Integer])\nsucCompactaSumaCuadradosDigitos = \n  partePuraPeriodica . sucSumaCuadradosDigitos1\n\n-- (partePuraPeriodica xs) es el par formado por la parte pura y la\n-- peri\u00f3dica de xs. Por ejemplo,\n--    \u03bb> partePuraPeriodica (sucSumaCuadradosDigitos 2016)\n--    ([2016,41,17,50,25,29,85],[89,145,42,20,4,16,37,58])\n--    \u03bb> partePuraPeriodica (sucSumaCuadradosDigitos 1976)\n--    ([1976,167,86,100],[1])\npartePuraPeriodica :: [Integer] -> ([Integer],[Integer])\npartePuraPeriodica = aux [] \n  where aux as (b:bs) | b `elem` as = span (\/=b) (reverse as)\n                      | otherwise = aux (b:as) bs\n\n-- 4\u00aa soluci\u00f3n\n-- ===========\n\nsucSumaCuadradosDigitos4 :: Integer -> [Integer]\nsucSumaCuadradosDigitos4 1  = repeat 1\nsucSumaCuadradosDigitos4 89 = cycle [89,145,42,20,4,16,37,58]\nsucSumaCuadradosDigitos4 n  =\n  n : sucSumaCuadradosDigitos4 (sumaCuadradosDigitos n)\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_sucSumaCuadradosDigitos :: Positive Integer -> NonNegative Int -> Bool\nprop_sucSumaCuadradosDigitos (Positive n) (NonNegative k) =\n  all (== sucSumaCuadradosDigitos1 n !! k)\n      [sucSumaCuadradosDigitos2 n !! k,\n       sucSumaCuadradosDigitos3 n !! k,\n       sucSumaCuadradosDigitos4 n !! k]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_sucSumaCuadradosDigitos\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> sucSumaCuadradosDigitos1 2000 !! (10^4)\n--    20\n--    (6.96 secs, 8,049,886,312 bytes)\n--    \u03bb> sucSumaCuadradosDigitos2 2000 !! (10^4)\n--    20\n--    (0.08 secs, 91,024,688 bytes)\n--    \u03bb> sucSumaCuadradosDigitos3 2000 !! (10^4)\n--    20\n--    (0.01 secs, 995,560 bytes)\n--    \u03bb> sucSumaCuadradosDigitos4 2000 !! (10^4)\n--    20\n--    (0.02 secs, 587,040 bytes)\n--    \n--    \u03bb> sucSumaCuadradosDigitos2 2000 !! (3*10^5)\n--    20\n--    (1.96 secs, 2,715,501,416 bytes)\n--    \u03bb> sucSumaCuadradosDigitos3 2000 !! (3*10^5)\n--    20\n--    (0.02 secs, 995,872 bytes)\n--    \u03bb> sucSumaCuadradosDigitos4 2000 !! (3*10^5)\n--    20\n--    (0.02 secs, 587,352 bytes)\n--    \n--    \u03bb> sucSumaCuadradosDigitos3 2000 !! (10^9)\n--    20\n--    (2.85 secs, 996,016 bytes)\n--    \u03bb> sucSumaCuadradosDigitos4 2000 !! (10^9)\n--    20\n--    (2.54 secs, 587,496 bytes)\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Sucesion_de_suma_de_cuadrados_de_los_digitos.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej5\"><\/a><\/p>\n<h3>5. La funci\u00f3n indicatriz de Euler<\/h3>\n<p>La <a href=\"https:\/\/bit.ly\/3yQbzA6\">indicatriz de Euler<\/a> (tambi\u00e9n  funci\u00f3n \u03c6 de Euler) es una funci\u00f3n importante en teor\u00eda de n\u00fameros. Si n es un entero positivo, entonces \u03c6(n) se define como el n\u00famero de enteros positivos menores o iguales a n y coprimos con n. Por ejemplo, \u03c6(36) = 12 ya que los n\u00fameros menores o iguales a 36 y coprimos con 36 son doce: 1, 5, 7, 11, 13, 17, 19, 23, 25, 29, 31, y 35.<\/p>\n<p>Definir la funci\u00f3n<\/p>\n<pre lang=\"text\">\n   phi :: Integer -> Integer\n<\/pre>\n<p>tal que (phi n) es igual a \u03c6(n). Por ejemplo,<\/p>\n<pre lang=\"text\">\n   phi 36                          ==  12\n   map phi [10..20]                ==  [4,10,4,12,6,8,8,16,6,18,8]\n   phi (3^10^5) `mod` (10^9)       ==  681333334\n   length (show (phi (10^(10^5)))) == 100000\n<\/pre>\n<p>Comprobar con QuickCheck que, para todo n > 0, \u03c6(10^n) tiene n d\u00edgitos.<\/p>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.List (genericLength, group)\nimport Data.Numbers.Primes (primeFactors)\nimport Math.NumberTheory.ArithmeticFunctions (totient)\nimport Test.QuickCheck (Positive (Positive), quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nphi1 :: Integer -> Integer\nphi1 n = genericLength [x | x <- [1..n], gcd x n == 1] \n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nphi2 :: Integer -> Integer\nphi2 n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n] \n    \nfactorizacion :: Integer -> [(Integer,Integer)]\nfactorizacion n =\n  [(head xs,genericLength xs) | xs <- group (primeFactors n)]\n\n-- 3\u00aa soluci\u00f3n\n-- =============\n\nphi3 :: Integer -> Integer\nphi3 n = \n  product [(x-1) * product xs | (x:xs) <- group (primeFactors n)]\n\n-- 4\u00aa soluci\u00f3n\n-- =============\n\nphi4 :: Integer -> Integer\nphi4 = totient \n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_phi :: Positive Integer -> Bool \nprop_phi (Positive n) =\n  all (== phi1 n)\n      [phi2 n,\n       phi3 n,\n       phi4 n]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_phi\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> phi1 (2*10^6)\n--    800000\n--    (2.49 secs, 2,117,853,856 bytes)\n--    \u03bb> phi2 (2*10^6)\n--    800000\n--    (0.02 secs, 565,664 bytes)\n--    \n--    \u03bb> length (show (phi2 (10^100000)))\n--    100000\n--    (2.80 secs, 5,110,043,208 bytes)\n--    \u03bb> length (show (phi3 (10^100000)))\n--    100000\n--    (4.81 secs, 7,249,353,896 bytes)\n--    \u03bb> length (show (phi4 (10^100000)))\n--    100000\n--    (0.78 secs, 1,467,573,768 bytes)\n\n-- Verificaci\u00f3n de la propiedad\n-- ============================\n\n-- La propiedad es\nprop_phi2 :: Positive Integer -> Bool\nprop_phi2 (Positive n) =\n  genericLength (show (phi4 (10^n))) == n\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_phi2\n--    +++ OK, passed 100 tests.\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/La_funcion_indicatriz_de_Euler.hs\">GitHub<\/a>.<\/p>\n","protected":false},"excerpt":{"rendered":"<p>Esta semana he publicado en Exercitium las soluciones de los siguientes problemas: 1. Primos con cubos 2. Sumas alternas de factoriales 3. Potencias perfectas 4. Sucesi\u00f3n de suma de cuadrados de los d\u00edgitos 5. La funci\u00f3n indicatriz de Euler 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\/7762"}],"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=7762"}],"version-history":[{"count":1,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7762\/revisions"}],"predecessor-version":[{"id":7763,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7762\/revisions\/7763"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=7762"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=7762"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=7762"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}