{"id":7755,"date":"2022-07-02T08:53:47","date_gmt":"2022-07-02T06:53:47","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=7755"},"modified":"2022-07-02T08:53:47","modified_gmt":"2022-07-02T06:53:47","slug":"pfh-la-semana-en-exercitium-1-de-julio-de-2022","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/pfh-la-semana-en-exercitium-1-de-julio-de-2022\/","title":{"rendered":"PFH: La semana en Exercitium (1 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. La sucesi\u00f3n del reloj astron\u00f3mico de Praga<\/a><\/li>\n<li><a href=\"#ej2\">2. Codificaci\u00f3n de Fibonacci<\/a><\/li>\n<li><a href=\"#ej3\">3. Pandigitales primos<\/a><\/li>\n<li><a href=\"#ej4\">4. Aproximaci\u00f3n del n\u00famero pi<\/a><\/li>\n<li><a href=\"#ej5\">5. N\u00fameros autodescriptivos<\/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. La sucesi\u00f3n del reloj astron\u00f3mico de Praga<\/h3>\n<p>La cadena infinita &#8220;1234321234321234321&#8230;&#8221;, formada por la repetici\u00f3n de los d\u00edgitos 123432, tiene una propiedad (en la que se basa el funcionamiento del <a href=\"http:\/\/bit.ly\/1FnWCQs\">reloj astron\u00f3mico de Praga<\/a>: la cadena se puede partir en una sucesi\u00f3n de n\u00fameros, de forma que la suma de los d\u00edgitos de dichos n\u00fameros es la sucesi\u00f3n de los n\u00fameros naturales, como se observa a continuaci\u00f3n:<\/p>\n<pre lang=\"text\">\n    1, 2, 3, 4, 32, 123, 43, 2123, 432, 1234, 32123, ...\n    1, 2, 3, 4,  5,   6,  7,    8,   9,   10,    11, ...\n<\/pre>\n<p>Definir la lista<\/p>\n<pre lang=\"text\">\n   reloj :: [Integer]\n<\/pre>\n<p>cuyos elementos son los t\u00e9rminos de la sucesi\u00f3n anterior. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   \u03bb> take 11 reloj\n   [1,2,3,4,32,123,43,2123,432,1234,32123]\n   \u03bb> (reloj !! 1000) `mod` (10^50)\n   23432123432123432123432123432123432123432123432123\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.List (inits, tails)\nimport Data.Char (digitToInt)\nimport Test.QuickCheck (NonNegative (NonNegative), quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nreloj1 :: [Integer]\nreloj1 = aux [1..] (cycle \"123432\")\n  where aux (n:ns) xs = read ys : aux ns zs\n          where (ys,zs) = prefijoSuma n xs\n\n-- (prefijoSuma n xs) es el par formado por el primer prefijo de xs cuyo\n-- suma es n y el resto de xs. Por ejemplo,\n--    prefijoSuma 6 \"12343\"  ==  (\"123\",\"43\")\nprefijoSuma :: Int -> String -> (String,String)\nprefijoSuma n xs = \n  head [(us,vs) | (us,vs) <- zip (inits xs) (tails xs)\n                , sumaD us == n]\n\n-- (sumaD xs) es la suma de los d\u00edgitos de xs. Por ejemplo,\n--    sumaD \"123\"  ==  6\nsumaD :: String -> Int\nsumaD = sum . map digitToInt\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nreloj2 :: [Integer]\nreloj2 = aux [1..] (cycle \"123432\")\n  where aux (n:ns) xs = read ys : aux ns zs\n          where (ys,zs) = prefijoSuma2 n xs\n\n-- (prefijoSuma n xs) es el par formado por el primer prefijo de xs cuyo\n-- suma es n y el resto de xs. Por ejemplo,\n--    prefijoSuma2 6 \"12343\"  ==  (\"123\",\"43\")\nprefijoSuma2 :: Int -> String -> (String,String)\nprefijoSuma2 n (x:xs) \n  | y == n = ([x],xs)\n  | otherwise = (x:ys,zs) \n  where y       = read [x]\n        (ys,zs) = prefijoSuma2 (n-y) xs\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_reloj :: NonNegative Int -> Bool\nprop_reloj (NonNegative n) =\n  reloj1 !! n == reloj2 !! n\n  \n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_reloj\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> (reloj1 !! 1000) `mod` (10^9)\n--    123432123\n--    (2.47 secs, 5,797,620,784 bytes)\n--    \u03bb> (reloj2 !! 1000) `mod` (10^9)\n--    123432123\n--    (0.44 secs, 798,841,528 bytes)\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/La_sucesion_del_reloj_astronomico_de_Praga.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej2\"><\/a><\/p>\n<h3>2. Codificaci\u00f3n de Fibonacci<\/h3>\n<p>La codificaci\u00f3n de Fibonacci http:\/\/bit.ly\/1Lllqjv de un n\u00famero n es una cadena d = d(0)d(1)&#8230;d(k-1)d(k) de ceros y unos tal que<\/p>\n<pre lang=\"text\">\n   n = d(0)\u00b7F(2) + d(1)\u00b7F(3) +...+ d(k-1)\u00b7F(k+1) \n   d(k-1) = d(k) = 1\n<\/pre>\n<p>donde F(i) es el i-\u00e9simo t\u00e9rmino de la sucesi\u00f3n de Fibonacci<\/p>\n<pre lang=\"text\">\n   0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ...\n<\/pre>\n<p>Por ejemplo, la codificaci\u00f3n de Fibonacci de 4 es &#8220;1011&#8221; ya que los dos \u00faltimos elementos son iguales a 1 y<\/p>\n<pre lang=\"text\">\n   1\u00b7F(2) + 0\u00b7F(3) + 1\u00b7F(4) = 1\u00b71 + 0\u00b72 + 1\u00b73 = 4\n<\/pre>\n<p>La codificaci\u00f3n de Fibonacci de los primeros n\u00fameros se muestra en la siguiente tabla<\/p>\n<pre lang=\"text\">\n    1  = 1     = F(2)           \u2261       11\n    2  = 2     = F(3)           \u2261      011\n    3  = 3     = F(4)           \u2261     0011\n    4  = 1+3   = F(2)+F(4)      \u2261     1011\n    5  = 5     = F(5)           \u2261    00011\n    6  = 1+5   = F(2)+F(5)      \u2261    10011\n    7  = 2+5   = F(3)+F(5)      \u2261    01011\n    8  = 8     = F(6)           \u2261   000011\n    9  = 1+8   = F(2)+F(6)      \u2261   100011\n   10  = 2+8   = F(3)+F(6)      \u2261   010011\n   11  = 3+8   = F(4)+F(6)      \u2261   001011\n   12  = 1+3+8 = F(2)+F(4)+F(6) \u2261   101011\n   13  = 13    = F(7)           \u2261  0000011\n   14  = 1+13  = F(2)+F(7)      \u2261  1000011\n<\/pre>\n<p>Definir la funci\u00f3n<\/p>\n<pre lang=\"text\">\n   codigoFib :: Integer -> String\n<\/pre>\n<p>tal que <code>(codigoFib n)<\/code> es la codificaci\u00f3n de Fibonacci del n\u00famero <code>n<\/code>. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   \u03bb> codigoFib 65\n   \"0100100011\"\n   \u03bb> [codigoFib n | n <- [1..7]]\n   [\"11\",\"011\",\"0011\",\"1011\",\"00011\",\"10011\",\"01011\"]\n<\/pre>\n<p>Comprobar con QuickCheck las siguientes propiedades:<\/p>\n<ul>\n<li>Todo entero positivo se puede descomponer en suma de n\u00fameros de la sucesi\u00f3n de Fibonacci.<\/li>\n<li>Las codificaciones de Fibonacci tienen como m\u00ednimo 2 elementos.<\/li>\n<li>En las codificaciones de Fibonacci, la cadena \"11\" s\u00f3lo aparece una vez y la \u00fanica vez que aparece es al final.<\/li>\n<\/ul>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.List (isInfixOf)\nimport Data.Array (Array, accumArray, elems)\nimport Test.QuickCheck (Positive (Positive), quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\ncodigoFib1 :: Integer -> String\ncodigoFib1 = concatMap show . codificaFibLista\n\n-- (codificaFibLista n) es la lista correspondiente a la codificaci\u00f3n de\n-- Fibonacci del n\u00famero n. Por ejemplo,\n--    \u03bb> codificaFibLista 65\n--    [0,1,0,0,1,0,0,0,1,1]\n--    \u03bb> [codificaFibLista n | n <- [1..7]]\n--    [[1,1],[0,1,1],[0,0,1,1],[1,0,1,1],[0,0,0,1,1],[1,0,0,1,1],[0,1,0,1,1]]\ncodificaFibLista :: Integer -> [Integer]\ncodificaFibLista n = map f [2..head xs] ++ [1]\n  where xs = map fst (descomposicion n)\n        f i | i `elem` xs = 1\n            | otherwise = 0\n\n-- (descomposicion n) es la lista de pares (i,f) tales que f es el\n-- i-\u00e9simo n\u00famero de Fibonacci y las segundas componentes es una\n-- sucesi\u00f3n decreciente de n\u00fameros de Fibonacci cuya suma es n. Por\n-- ejemplo, \n--    descomposicion 65  ==  [(10,55),(6,8),(3,2)]\n--    descomposicion 66  ==  [(10,55),(6,8),(4,3)]\ndescomposicion :: Integer -> [(Integer, Integer)]\ndescomposicion 0 = []\ndescomposicion 1 = [(2,1)]\ndescomposicion n = (i,x) : descomposicion (n-x)\n  where (i,x) = fibAnterior n\n\n-- (fibAnterior n) es el mayor n\u00famero de Fibonacci menor o igual que\n-- n. Por ejemplo,\n--    fibAnterior 33  ==  (8,21)\n--    fibAnterior 34  ==  (9,34)\nfibAnterior :: Integer -> (Integer, Integer)\nfibAnterior n = last (takeWhile p fibsConIndice)\n  where p (_,x) = x <= n\n\n-- fibsConIndice es la sucesi\u00f3n de los n\u00fameros de Fibonacci junto con\n-- sus \u00edndices. Por ejemplo,\n--    \u03bb> take 10 fibsConIndice\n--    [(0,0),(1,1),(2,1),(3,2),(4,3),(5,5),(6,8),(7,13),(8,21),(9,34)]\nfibsConIndice :: [(Integer, Integer)]\nfibsConIndice = zip [0..] fibs\n\n-- fibs es la sucesi\u00f3n de Fibonacci. Por ejemplo, \n--    take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]\nfibs :: [Integer]\nfibs = 0 : 1 : zipWith (+) fibs (tail fibs)\n\n--- 2\u00aa soluci\u00f3n\n-- ============\n\ncodigoFib2 :: Integer -> String\ncodigoFib2 = concatMap show . elems . codificaFibVec\n\n-- (codificaFibVec n) es el vector correspondiente a la codificaci\u00f3n de\n-- Fibonacci del n\u00famero n. Por ejemplo,\n--    \u03bb> codificaFibVec 65\n--    array (0,9) [(0,0),(1,1),(2,0),(3,0),(4,1),(5,0),(6,0),(7,0),(8,1),(9,1)]\n--    \u03bb> [elems (codificaFibVec n) | n <- [1..7]]\n--    [[1,1],[0,1,1],[0,0,1,1],[1,0,1,1],[0,0,0,1,1],[1,0,0,1,1],[0,1,0,1,1]]\ncodificaFibVec :: Integer -> Array Integer Integer\ncodificaFibVec n = accumArray (+) 0 (0,a+1) ((a+1,1):is) \n  where is = [(i-2,1) | (i,_) <- descomposicion n]\n        a  = fst (head is)\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_codigoFib :: Positive Integer -> Bool \nprop_codigoFib (Positive n) =\n  codigoFib1 n == codigoFib2 n\n  \n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_codigoFib\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> head [n | n <- [1..], length (codigoFib1 n) > 25]\n--    121393\n--    (4.30 secs, 3,031,108,104 bytes)\n--    \u03bb> head [n | n <- [1..], length (codigoFib2 n) > 25]\n--    121393\n--    (3.46 secs, 2,505,869,616 bytes)\n\n-- Propiedades\n-- ===========\n\n-- Usaremos la 2\u00aa definici\u00f3n\ncodigoFib :: Integer -> String\ncodigoFib = codigoFib2\n\n-- Prop.: La funci\u00f3n descomposicion es correcta:\nprop_descomposicion_correcta :: Positive Integer -> Bool\nprop_descomposicion_correcta (Positive n) =\n  n == sum (map snd (descomposicion n))\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_descomposicion_correcta\n--    +++ OK, passed 100 tests.\n\n-- Prop.: Todo entero positivo se puede descomponer en suma de n\u00fameros de\n-- la sucesi\u00f3n de Fibonacci.\nprop_descomposicion :: Positive Integer -> Bool\nprop_descomposicion (Positive n) =\n  not (null (descomposicion n))\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_descomposicion\n--    +++ OK, passed 100 tests.\n\n-- Prop.: Las codificaciones de Fibonacci tienen como m\u00ednimo 2 elementos.\nprop_length_codigoFib :: Positive Integer -> Bool\nprop_length_codigoFib (Positive n) =\n  length (codigoFib n) >= 2\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_length_codigoFib\n--    +++ OK, passed 100 tests.\n\n-- Prop.: En las codificaciones de Fibonacci, la cadena \"11\" s\u00f3lo\n-- aparece una vez y la \u00fanica vez que aparece es al final.\nprop3_cadena_11_en_codigoFib :: Positive Integer -> Bool\nprop3_cadena_11_en_codigoFib (Positive n) = \n  take 2 xs == \"11\" && not (\"11\" `isInfixOf` drop 2 xs)\n  where xs = reverse (codigoFib n)\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop3_cadena_11_en_codigoFib\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\/Codificacion_de_Fibonacci.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej3\"><\/a><\/p>\n<h3>3. Pandigitales primos<\/h3>\n<p>Un n\u00famero con n d\u00edgitos es pandigital si contiene todos los d\u00edgitos del 1 a n exactamente una vez. Por ejemplo, 2143 es un pandigital con 4 d\u00edgitos y, adem\u00e1s, es primo.<\/p>\n<p>Definir la lista<\/p>\n<pre lang=\"text\">\n   pandigitalesPrimos :: [Int]\n<\/pre>\n<p>tal que sus elementos son los n\u00fameros pandigitales primos, ordenados de mayor a menor. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   take 3 pandigitalesPrimos       ==  [7652413,7642513,7641253]\n   2143 `elem` pandigitalesPrimos  ==  True\n   length pandigitalesPrimos       ==  538\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.List (permutations, sort)\nimport Data.Char (intToDigit)\nimport Data.Numbers.Primes (isPrime)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\npandigitalesPrimos1 :: [Int]\npandigitalesPrimos1 =\n  concatMap nPandigitalesPrimos1 [9,8..1]\n\n-- (nPandigitalesPrimos n) es la lista de los n\u00fameros pandigitales con n\n-- d\u00edgitos, ordenada de mayor a menor. Por ejemplo,\n--    nPandigitalesPrimos 4  ==  [4231,2341,2143,1423]\n--    nPandigitalesPrimos 5  ==  []\nnPandigitalesPrimos1 :: Int -> [Int]\nnPandigitalesPrimos1 n = filter isPrime (pandigitales n)\n\n-- (pandigitales n) es la lista de los n\u00fameros pandigitales de n d\u00edgitos\n-- ordenada de mayor a menor. Por ejemplo,\n--    pandigitales 3  ==  [321,312,231,213,132,123]\npandigitales :: Int -> [Int]\npandigitales n = \n    reverse $ sort $ map digitosAentero (permutations [1..n])\n\n-- (digitosAentero ns) es el n\u00famero cuyos d\u00edgitos son ns. Por ejemplo,\n--    digitosAentero [3,2,5]  ==  325\ndigitosAentero :: [Int] -> Int\ndigitosAentero = read . map intToDigit\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\npandigitalesPrimos2 :: [Int]\npandigitalesPrimos2 =\n  concatMap nPandigitalesPrimos2 [9,8..1]\n\n-- Nota. La definici\u00f3n de nPandigitalesPrimos1 se puede simplificar, ya\n-- que la suma de los n\u00fameros de 1 a n es divisible por 3, entonces los\n-- n\u00fameros  pandigitales con n d\u00edgitos tambi\u00e9n lo son y, por tanto, no\n-- son primos. \nnPandigitalesPrimos2 :: Int -> [Int]\nnPandigitalesPrimos2 n \n  | sum [1..n] `mod` 3 == 0 = []\n  | otherwise               = filter isPrime (pandigitales n)\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\npandigitalesPrimos3 :: [Int]\npandigitalesPrimos3 =\n  concatMap nPandigitalesPrimos3 [9,8..1]\n\n-- La definici\u00f3n de nPandigitales se puede simplificar, ya que\n--    \u03bb> [n | n <- [1..9], sum [1..n] `mod` 3 \/= 0]\n--    [1,4,7]\nnPandigitalesPrimos3 :: Int -> [Int]\nnPandigitalesPrimos3 n \n  | n `elem` [4,7] = filter isPrime (pandigitales n)\n  | otherwise      = []\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_pandigitalesPrimos :: Bool\nprop_pandigitalesPrimos =\n  all (== pandigitalesPrimos1)\n      [pandigitalesPrimos2,\n       pandigitalesPrimos3]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> prop_pandigitalesPrimos\n--    True\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> length (pandigitalesPrimos1)\n--    538\n--    (1.44 secs, 5,249,850,032 bytes)\n--    \u03bb> length (pandigitalesPrimos2)\n--    538\n--    (0.14 secs, 619,249,632 bytes)\n--    \u03bb> length (pandigitalesPrimos3)\n--    538\n--    (0.14 secs, 619,237,464 bytes)\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Pandigitales_primos.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej4\"><\/a><\/p>\n<h3>4. Aproximaci\u00f3n del n\u00famero pi<\/h3>\n<p>Una forma de aproximar el n\u00famero \u03c0 es usando la siguiente igualdad:<\/p>\n<pre lang=\"text\">\n    \u03c0         1     1\u00b72     1\u00b72\u00b73     1\u00b72\u00b73\u00b74     \n   --- = 1 + --- + ----- + ------- + --------- + ....\n    2         3     3\u00b75     3\u00b75\u00b77     3\u00b75\u00b77\u00b79\n<\/pre>\n<p>Es decir, la serie cuyo t\u00e9rmino general n-\u00e9simo es el cociente entre el producto de los primeros n n\u00fameros y los primeros n n\u00fameros impares:<\/p>\n<pre lang=\"text\">\n               \u03a0 i   \n   s(n) =  -----------\n            \u03a0 (2*i+1)\n<\/pre>\n<p>Definir la funci\u00f3n<\/p>\n<pre lang=\"text\">\n   aproximaPi :: Integer -> Double\n<\/pre>\n<p>tal que (aproximaPi n) es la aproximaci\u00f3n del n\u00famero \u03c0 calculada con la serie anterior hasta el t\u00e9rmino n-\u00e9simo. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   aproximaPi 10     == 3.1411060206\n   aproximaPi 20     == 3.1415922987403397\n   aproximaPi 30     == 3.1415926533011596\n   aproximaPi 40     == 3.1415926535895466\n   aproximaPi 50     == 3.141592653589793\n   aproximaPi (10^4) == 3.141592653589793\n   pi                == 3.141592653589793\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.Ratio ((%))\nimport Data.List (genericTake)\nimport Test.QuickCheck (Property, arbitrary, forAll, suchThat, quickCheck)\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\naproximaPi1 :: Integer -> Double\naproximaPi1 n = \n  fromRational (2 * sum [product [1..i] % product [1,3..2*i+1] | i <- [0..n]])\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\naproximaPi2 :: Integer -> Double\naproximaPi2 0 = 2\naproximaPi2 n = \n  aproximaPi2 (n-1) + fromRational (2 * product [1..n] % product [3,5..2*n+1])\n\n-- 3\u00aa soluci\u00f3n\n-- ===========\n\naproximaPi3 :: Integer -> Double\naproximaPi3 n = \n  fromRational (2 * (1 + sum (zipWith (%) numeradores (genericTake n denominadores))))\n\n-- numeradores es la sucesi\u00f3n de los numeradores. Por ejemplo,\n--    \u03bb> take 10 numeradores\n--    [1,2,6,24,120,720,5040,40320,362880,3628800]\nnumeradores :: [Integer]\nnumeradores = scanl (*) 1 [2..]\n\n-- denominadores es la sucesi\u00f3n de los denominadores. Por ejemplo,\n--    \u03bb> take 10 denominadores\n--    [3,15,105,945,10395,135135,2027025,34459425,654729075,13749310575]\ndenominadores :: [Integer]\ndenominadores = scanl (*) 3 [5, 7..]\n \n-- 4\u00aa soluci\u00f3n\n-- ===========\n\naproximaPi4 :: Integer -> Double\naproximaPi4 n = \n  read (x : \".\" ++ xs)\n  where (x:xs) = show (aproximaPi4' n)\n\naproximaPi4' :: Integer -> Integer\naproximaPi4' n = \n  2 * (p + sum (zipWith div (map (*p) numeradores) (genericTake n denominadores))) \n  where p = 10^n\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_aproximaPi :: Property\nprop_aproximaPi =\n  forAll (arbitrary `suchThat` (> 3)) $ \\n ->\n  all (=~ aproximaPi1 n)\n      [aproximaPi2 n,\n       aproximaPi3 n,\n       aproximaPi4 n]\n\n(=~) :: Double -> Double -> Bool\nx =~ y = abs (x - y) < 0.001\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_aproximaPi\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> aproximaPi1 3000 \n--    3.141592653589793\n--    (4.96 secs, 27,681,824,408 bytes)\n--    \u03bb> aproximaPi2 3000 \n--    3.1415926535897922\n--    (3.00 secs, 20,496,194,496 bytes)\n--    \u03bb> aproximaPi3 3000 \n--    3.141592653589793\n--    (3.13 secs, 13,439,528,432 bytes)\n--    \u03bb> aproximaPi4 3000 \n--    3.141592653589793\n--    (0.09 secs, 23,142,144 bytes)\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Aproximacion_de_numero_pi.hs\">GitHub<\/a>.<\/p>\n<p><a name=\"ej5\"><\/a><\/p>\n<h3>5. N\u00fameros autodescriptivos<\/h3>\n<p>Un n\u00famero n es autodescriptivo cuando para cada posici\u00f3n k de n (empezando a contar las posiciones a partir de 0), el d\u00edgito en la posici\u00f3n k es igual al n\u00famero de veces que ocurre k en n. Por ejemplo, 1210 es autodescriptivo porque tiene 1 d\u00edgito igual a \"0\", 2 d\u00edgitos iguales a \"1\", 1 d\u00edgito igual a \"2\" y ning\u00fan d\u00edgito igual a \"3\".<\/p>\n<p>Definir la funci\u00f3n<\/p>\n<pre lang=\"text\">\n   autodescriptivo :: Integer -> Bool\n<\/pre>\n<p>tal que <code>(autodescriptivo n)<\/code> se verifica si <code>n<\/code> es autodescriptivo. Por ejemplo,<\/p>\n<pre lang=\"text\">\n   \u03bb> autodescriptivo 1210\n   True\n   \u03bb> [x | x <- [1..100000], autodescriptivo x]\n   [1210,2020,21200]\n   \u03bb> autodescriptivo 9210000001000\n   True\n<\/pre>\n<p><!--more--><\/p>\n<h4>Soluciones<\/h4>\n<pre lang=\"haskell\">\nimport Data.Char (digitToInt)\nimport Data.List (genericLength)\nimport Test.QuickCheck\n\n-- 1\u00aa soluci\u00f3n\n-- ===========\n\nautodescriptivo1 :: Integer -> Bool\nautodescriptivo1 n = autodescriptiva (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-- (autodescriptiva ns) se verifica si la lista de d\u00edgitos ns es\n-- autodescriptiva; es decir, si para cada posici\u00f3n k de ns\n-- (empezando a contar las posiciones a partir de 0), el d\u00edgito en la\n-- posici\u00f3n k es igual al n\u00famero de veces que ocurre k en ns. Por\n-- ejemplo, \n--    autodescriptiva [1,2,1,0] == True\n--    autodescriptiva [1,2,1,1] == False\nautodescriptiva :: [Integer] -> Bool\nautodescriptiva ns = \n  and [x == ocurrencias k ns | (k,x) <- zip [0..] ns]\n\n-- (ocurrencias x ys) es el n\u00famero de veces que ocurre x en ys. Por\n-- ejemplo, \n--    ocurrencias 1 [1,2,1,0,1] == 3\nocurrencias :: Integer -> [Integer] -> Integer\nocurrencias x ys = genericLength (filter (==x) ys)\n\n-- 2\u00aa soluci\u00f3n\n-- ===========\n\nautodescriptivo2 :: Integer -> Bool\nautodescriptivo2 n =\n  and (zipWith (==) (map digitToInt xs)\n                    [length (filter (==c) xs) |  c <- ['0'..'9']])\n  where xs = show n\n\n-- Comprobaci\u00f3n de equivalencia\n-- ============================\n\n-- La propiedad es\nprop_autodescriptivo :: Positive Integer -> Bool\nprop_autodescriptivo (Positive n) =\n  autodescriptivo1 n == autodescriptivo2 n\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_autodescriptivo\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> [x | x <- [1..3*10^5], autodescriptivo1 x]\n--    [1210,2020,21200]\n--    (2.59 secs, 6,560,244,696 bytes)\n--    \u03bb> [x | x <- [1..3*10^5], autodescriptivo2 x]\n--    [1210,2020,21200]\n--    (0.67 secs, 425,262,848 bytes)\n<\/pre>\n<p>El c\u00f3digo se encuentra en <a href=\"https:\/\/github.com\/jaalonso\/Exercitium\/blob\/main\/src\/Numeros_autodescriptivos.hs\">GitHub<\/a>.<\/p>\n","protected":false},"excerpt":{"rendered":"<p>Esta semana he publicado en Exercitium las soluciones de los siguientes problemas: 1. La sucesi\u00f3n del reloj astron\u00f3mico de Praga 2. Codificaci\u00f3n de Fibonacci 3. Pandigitales primos 4. Aproximaci\u00f3n del n\u00famero pi 5. N\u00fameros autodescriptivos 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\/7755"}],"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=7755"}],"version-history":[{"count":1,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7755\/revisions"}],"predecessor-version":[{"id":7756,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7755\/revisions\/7756"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=7755"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=7755"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=7755"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}