Menu Close

Etiqueta: Teoría de números

Mayor órbita de la sucesión de Collatz

José A. Alonso, ,

Se considera la siguiente operación, aplicable a cualquier número entero positivo:

  • Si el número es par, se divide entre 2.
  • Si el número es impar, se multiplica por 3 y se suma 1.

Dado un número cualquiera, podemos calcular su órbita; es decir, las imágenes sucesivas al iterar la función. Por ejemplo, la órbita de 13 es

   13, 40, 20, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1,...

Si observamos este ejemplo, la órbita de 13 es periódica, es decir, se repite indefinidamente a partir de un momento dado). La conjetura de Collatz dice que siempre alcanzaremos el 1 para cualquier número con el que comencemos. Por ejemplo,

  • Empezando en n = 6 se obtiene 6, 3, 10, 5, 16, 8, 4, 2, 1.
  • Empezando en n = 11 se obtiene: 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1.
  • Empezando en n = 27, la sucesión tiene 112 pasos, llegando hasta 9232 antes de descender a 1: 27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1.

Definir la función

   mayoresGeneradores :: Integer -> [Integer]

tal que (mayoresGeneradores n) es la lista de los números menores o iguales que n cuyas órbitas de Collatz son las de mayor longitud. Por ejemplo,

   mayoresGeneradores 20      ==  [18,19]
   mayoresGeneradores (10^6)  ==  [837799]

Soluciones

import qualified Data.MemoCombinators as Memo (integral)
import Data.List (genericLength, genericTake, maximumBy)
import Test.QuickCheck (Positive(..), quickCheck)
 
-- 1ª solución
-- ===========
 
mayoresGeneradores :: Integer -> [Integer]
mayoresGeneradores n =
  [x | (x,y) <- ps, y == m]
  where ps = genericTake n longitudesOrbitas
        m  = maximum (map snd ps)
 
-- longitudesOrbita es la lista de los números junto a las longitudes de
-- las órbitas de Collatz que generan. Por ejemplo,
--    λ> take 10 longitudesOrbitas
--    [(1,1),(2,2),(3,8),(4,3),(5,6),(6,9),(7,17),(8,4),(9,20),(10,7)]
longitudesOrbitas :: [(Integer, Integer)]
longitudesOrbitas =
  [(n, genericLength (collatz n)) | n <- [1..]]
 
-- (siguiente n) es el siguiente de n en la sucesión de Collatz. Por
-- ejemplo,
--    siguiente 13  ==  40
--    siguiente 40  ==  20
siguiente :: Integer -> Integer
siguiente n | even n    = n `div` 2
            | otherwise = 3*n+1
 
-- (collatz1 n) es la órbita de Collatz de n hasta alcanzar el
-- 1. Por ejemplo,
--    collatz 13  ==  [13,40,20,10,5,16,8,4,2,1]
 
-- 1ª definición de collatz
collatz1 :: Integer -> [Integer]
collatz1 1 = [1]
collatz1 n = n : collatz1 (siguiente n)
 
-- 2ª definición de collatz
collatz2 :: Integer -> [Integer]
collatz2 n = takeWhile (/=1) (iterate siguiente n) ++ [1]
 
-- Usaremos la 2ª definición de collatz
collatz :: Integer -> [Integer]
collatz = collatz2
 
-- 2ª solución
-- ===========
 
mayoresGeneradores2 :: Integer -> [Integer]
mayoresGeneradores2 n =
  [x | (x,y) <- ps, y == m]
  where ps = [(x, longitudOrbita x) | x <- [1..n]]
        m  = maximum (map snd ps)
 
-- (longitudOrbita x) es la longitud de la órbita de x. Por ejemplo,
--    longitudOrbita 13  ==  10
longitudOrbita :: Integer -> Integer
longitudOrbita 1 = 1
longitudOrbita x = 1 + longitudOrbita (siguiente x)
 
-- 3ª solución
-- ===========
 
mayoresGeneradores3 :: Integer -> [Integer]
mayoresGeneradores3 n =
  [x | (x,y) <- ps, y == m]
  where ps = [(x, longitudOrbita2 x) | x <- [1..n]]
        m  = maximum (map snd ps)
 
longitudOrbita2 :: Integer -> Integer
longitudOrbita2 = Memo.integral longitudOrbita2'
  where
    longitudOrbita2' 1 = 1
    longitudOrbita2' x = 1 + longitudOrbita2 (siguiente x)
 
 
-- Equivalencia de definiciones
-- ============================
 
-- La propiedad es
prop_mayoresGeneradores :: (Positive Integer) -> Bool
prop_mayoresGeneradores (Positive n) =
  all (== (mayoresGeneradores n))
      [mayoresGeneradores2 n,
       mayoresGeneradores3 n]
 
-- La comprobación es
--    λ> quickCheck prop_mayoresGeneradores
--    +++ OK, passed 100 tests.
 
-- Comprobación de eficiencia
-- ==========================
 
-- La comprobación es
--    λ> mayoresGeneradores (10^5)
--    [77031]
--    (5.43 secs, 6,232,320,064 bytes)
--    λ> mayoresGeneradores2 (10^5)
--    [77031]
--    (7.68 secs, 5,238,991,616 bytes)
--    λ> mayoresGeneradores3 (10^5)
--    [77031]
--    (0.88 secs, 571,788,736 bytes)

El código se encuentra en GitHub.

Leer más →

Ternas pitagóricas con suma dada

José A. Alonso, ,

Una terna pitagórica es una terna de números naturales (a,b,c) tal que a<b<c y a^2+b^2=c^2. Por ejemplo (3,4,5) es una terna pitagórica.

Definir la función

   ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]

tal que (ternasPitagoricas x) es la lista de las ternas pitagóricas cuya suma es x. Por ejemplo,

   ternasPitagoricas 12     == [(3,4,5)]
   ternasPitagoricas 60     == [(10,24,26),(15,20,25)]
   ternasPitagoricas (10^6) == [(218750,360000,421250),(200000,375000,425000)]

Soluciones

import Data.List (nub,sort)
import Test.QuickCheck
 
-- 1ª solución                                                   --
-- ===========
 
ternasPitagoricas1 :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas1 x =
  [(a,b,c) | a <- [0..x],
             b <- [a+1..x],
             c <- [b+1..x],
             a^2 + b^2 == c^2,
             a+b+c == x]
 
-- 2ª solución                                                   --
-- ===========
 
ternasPitagoricas2 :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas2 x =
  [(a,b,c) | a <- [1..x],
             b <- [a+1..x-a],
             let c = x-a-b,
             a^2+b^2 == c^2]
 
-- 3ª solución                                                   --
-- ===========
 
-- Todas las ternas pitagóricas primitivas (a,b,c) pueden representarse
-- por
--    a = m^2 - n^2, b = 2*m*n, c = m^2 + n^2,
-- con 1 <= n < m. (Ver en https://bit.ly/35UNY6L ).
 
ternasPitagoricas3 :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas3 x =
  nub [(d*a,d*b,d*c) | d <- [1..x],
                       x `mod` d == 0,
                      (a,b,c) <- aux (x `div` d)]
  where
    aux y = [(a,b,c) | m <- [2..limite],
                       n <- [1..m-1],
                       let [a,b] = sort [m^2 - n^2, 2*m*n],
                       let c = m^2 + n^2,
                       a+b+c == y]
      where limite = ceiling (sqrt (fromIntegral y))
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_ternasPitagoricas :: Positive Integer -> Bool
prop_ternasPitagoricas (Positive x) =
  all (== (ternasPitagoricas1 x))
      [ternasPitagoricas2 x,
       ternasPitagoricas3 x]
 
-- La comprobación es
--    λ> quickCheck prop_ternasPitagoricas
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> ternasPitagoricas1 200
--    [(40,75,85)]
--    (1.90 secs, 2,404,800,856 bytes)
--    λ> ternasPitagoricas2 200
--    [(40,75,85)]
--    (0.06 secs, 19,334,232 bytes)
--    λ> ternasPitagoricas3 200
--    [(40,75,85)]
--    (0.01 secs, 994,224 bytes)
--
--    λ> ternasPitagoricas2 3000
--    [(500,1200,1300),(600,1125,1275),(750,1000,1250)]
--    (4.41 secs, 4,354,148,136 bytes)
--    λ> ternasPitagoricas3 3000
--    [(500,1200,1300),(600,1125,1275),(750,1000,1250)]
--    (0.05 secs, 17,110,360 bytes)

El código se encuentra en GitHub.

Leer más →

Exponente en la factorización

José A. Alonso, ,

Definir la función

   exponente :: Integer -> Integer -> Int

tal que (exponente x n) es el exponente de x en la factorizacón prima de n (se supone que x > 1 y n > 0). Por ejemplo,

   exponente 2 24  ==  3
   exponente 3 24  ==  1
   exponente 6 24  ==  0
   exponente 7 24  ==  0

Soluciones

import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
exponente1 :: Integer -> Integer -> Int
exponente1 x n
  | esPrimo x = aux n
  | otherwise = 0
  where aux m | m `mod` x == 0 = 1 + aux (m `div` x)
              | otherwise      = 0
 
-- (esPrimo x) se verifica si x es un número primo. Por ejemplo,
--    esPrimo 7  ==  True
--    esPrimo 8  ==  False
esPrimo :: Integer -> Bool
esPrimo x =
  [y | y <- [1..x], x `mod` y == 0] == [1,x]
 
-- 2ª solución
-- ===========
 
exponente2 :: Integer -> Integer -> Int
exponente2 x n
  | esPrimo x = length (takeWhile (`divisible` x) (iterate (`div` x) n))
  | otherwise = 0
 
-- (divisible n x) se verifica si ne divisible por x. Por ejemplo,
--    divisible 6 2  ==  True
--    divisible 7 2  ==  False
divisible :: Integer -> Integer -> Bool
divisible n x = n `mod` x == 0
 
-- 3ª solución
-- ===========
 
exponente3 :: Integer -> Integer -> Int
exponente3 x n =
  length (filter (==x) (primeFactors n))
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_exponente :: Integer -> Integer -> Property
prop_exponente x n =
  x > 1 && n > 0 ==>
  exponente1 x n == exponente2 x n &&
  exponente1 x n == exponente3 x n
 
-- La comprobación es
--    λ> quickCheck prop_exponente
--    +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Leer más →

Reconocimiento de potencias de 4

José A. Alonso, ,

Definir la función

   esPotenciaDe4 :: Integral a => a -> Bool

tal que (esPotenciaDe4 n) se verifica si n es una potencia de 4. Por ejemplo,

   esPotenciaDe4 16                ==  True
   esPotenciaDe4 17                ==  False
   esPotenciaDe4 (4^(4*10^5))      ==  True
   esPotenciaDe4 (1 + 4^(4*10^5))  ==  False

Soluciones

-- 1ª solución
-- ===========
 
esPotenciaDe4_1 :: Integral a => a -> Bool
esPotenciaDe4_1 0 = False
esPotenciaDe4_1 1 = True
esPotenciaDe4_1 n = n `mod` 4 == 0 && esPotenciaDe4_1 (n `div` 4)
 
-- 2ª solución
-- ===========
 
esPotenciaDe4_2 :: Integral a => a -> Bool
esPotenciaDe4_2 n = n `pertenece` potenciasDe4
 
-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,
--    take 5 potenciasDe4  ==  [1,4,16,64,256]
potenciasDe4 :: Integral a => [a]
potenciasDe4 = [4^x | x <- [0..]]
 
-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- (posiblemente infinita xs). Por ejemplo,
--    pertenece 8 [2,4..]  ==  True
--    pertenece 9 [2,4..]  ==  False
pertenece :: Integral a => a -> [a] -> Bool
pertenece x ys = x == head (dropWhile (<x) ys)
 
-- 3ª solución
-- ===========
 
esPotenciaDe4_3 :: Integral a => a -> Bool
esPotenciaDe4_3 n = n `pertenece` potenciasDe4_2
 
-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,
--    take 5 potenciasDe4  ==  [1,4,16,64,256]
potenciasDe4_2 :: Integral a => [a]
potenciasDe4_2 = iterate (*4) 1
 
-- 4ª solución
-- ===========
 
esPotenciaDe4_4 :: Integral n => n -> Bool
esPotenciaDe4_4 n =
  n == head (dropWhile (<n) (iterate (*4) 1))
 
-- 5ª solución
-- ===========
 
esPotenciaDe4_5 :: Integral n => n -> Bool
esPotenciaDe4_5 n =
  n == until (>=n) (*4) 1
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> esPotenciaDe4_1 (4^(4*10^4))
--    True
--    (0.18 secs, 233,903,248 bytes)
--    λ> esPotenciaDe4_2 (4^(4*10^4))
--    True
--    (2.01 secs, 756,125,712 bytes)
--    λ> esPotenciaDe4_3 (4^(4*10^4))
--    True
--    (0.05 secs, 212,019,464 bytes)
--    λ> esPotenciaDe4_4 (4^(4*10^4))
--    True
--    (0.05 secs, 212,019,368 bytes)
--    λ> esPotenciaDe4_5 (4^(4*10^4))
--    True
--    (0.07 secs, 209,779,888 bytes)
--
--    λ> esPotenciaDe4_3 (4^(2*10^5))
--    True
--    (0.64 secs, 5,184,667,280 bytes)
--    λ> esPotenciaDe4_4 (4^(2*10^5))
--    True
--    (0.64 secs, 5,184,667,200 bytes)
--    λ> esPotenciaDe4_5 (4^(2*10^5))
--    True
--    (0.63 secs, 5,173,467,656 bytes)
--
--    λ> esPotenciaDe4_3 (4^(4*10^5))
--    True
--    (2.27 secs, 20,681,727,464 bytes)
--    λ> esPotenciaDe4_4 (4^(4*10^5))
--    True
--    (2.30 secs, 20,681,727,320 bytes)
--    λ> esPotenciaDe4_5 (4^(4*10^5))
--    True
--    (2.28 secs, 20,659,327,352 bytes)

El código se encuentra en GitHub.

Leer más →

Sistema factorádico de numeración

José A. Alonso, ,

El sistema factorádico es un sistema numérico basado en factoriales en el que el n-ésimo dígito, empezando desde la derecha, debe ser multiplicado por n! Por ejemplo, el número “341010” en el sistema factorádico es 463 en el sistema decimal ya que

   3×5! + 4×4! + 1×3! + 0×2! + 1×1! + 0×0! = 463

En este sistema numérico, el dígito de más a la derecha es siempre 0, el segundo 0 o 1, el tercero 0,1 o 2 y así sucesivamente.

Con los dígitos del 0 al 9 el mayor número que podemos codificar es el 10!-1 = 3628799. En cambio, si lo ampliamos con las letras A a Z podemos codificar hasta 36!-1 = 37199332678990121746799944815083519999999910.

Definir las funciones

   factoradicoAdecimal :: String -> Integer
   decimalAfactoradico :: Integer -> String

tales que

  • (factoradicoAdecimal cs) es el número decimal correspondiente al número factorádico cs. Por ejemplo,
     λ> decimalAfactoradico 463
     "341010"
     λ> decimalAfactoradico 2022
     "2441000"
     λ> decimalAfactoradico 36288000
     "A0000000000"
     λ> map decimalAfactoradico [1..10]
     ["10","100","110","200","210","1000","1010","1100","1110","1200"]
     λ> decimalAfactoradico 37199332678990121746799944815083519999999
     "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"
  • (decimalAfactoradico n) es el número factorádico correpondiente al número decimal n. Por ejemplo,
     λ> factoradicoAdecimal "341010"
     463
     λ> factoradicoAdecimal "2441000"
     2022
     λ> factoradicoAdecimal "A0000000000"
     36288000
     λ> map factoradicoAdecimal ["10","100","110","200","210","1000","1010","1100","1110","1200"]
     [1,2,3,4,5,6,7,8,9,10]
     λ> factoradicoAdecimal "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"
     37199332678990121746799944815083519999999

Comprobar con QuickCheck que, para cualquier entero positivo n,

   factoradicoAdecimal (decimalAfactoradico n) == n

Soluciones

{-# LANGUAGE TupleSections #-}
 
import Data.List (genericIndex, genericLength)
import qualified Data.Map as M
import Test.QuickCheck
import Test.Hspec
 
-- 1ª solución
-- ===========
 
factoradicoAdecimal1 :: String -> Integer
factoradicoAdecimal1 cs = sum (zipWith (*) xs ys)
  where xs = map caracterAentero cs
        n  = length cs
        ys = reverse (take n facts)
 
-- (caracterAentero c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero '0'  ==  0
--    caracterAentero '1'  ==  1
--    caracterAentero '9'  ==  9
--    caracterAentero 'A'  ==  10
--    caracterAentero 'B'  ==  11
--    caracterAentero 'Z'  ==  35
caracterAentero :: Char -> Integer
caracterAentero c =
  head [n | (n,x) <- zip [0..] caracteres, x == c]
 
-- caracteres es la lista de caracteres
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']
caracteres :: String
caracteres = ['0'..'9'] ++ ['A'..'Z']
 
-- facts es la lista de los factoriales. Por ejemplo,
--    λ> take 12 facts
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
facts :: [Integer]
facts = scanl (*) 1 [1..]
 
decimalAfactoradico1 :: Integer -> String
decimalAfactoradico1 n = aux n (reverse (takeWhile (<=n) facts))
  where aux 0 xs     = ['0' | _ <- xs]
        aux m (x:xs) = enteroAcaracter (m `div` x) : aux (m `mod` x) xs
 
-- (enteroAcaracter k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter 0   ==  '0'
--    enteroAcaracter 1   ==  '1'
--    enteroAcaracter 9   ==  '9'
--    enteroAcaracter 10  ==  'A'
--    enteroAcaracter 11  ==  'B'
--    enteroAcaracter 35  ==  'Z'
enteroAcaracter :: Integer -> Char
enteroAcaracter k = caracteres `genericIndex` k
 
-- 2ª solución
-- ===========
 
factoradicoAdecimal2 :: String -> Integer
factoradicoAdecimal2 cs = sum (zipWith (*) xs ys)
    where xs = map caracterAentero2 cs
          n  = length cs
          ys = reverse (take n facts)
 
-- (caracterAentero2 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero2 '0'  ==  0
--    caracterAentero2 '1'  ==  1
--    caracterAentero2 '9'  ==  9
--    caracterAentero2 'A'  ==  10
--    caracterAentero2 'B'  ==  11
--    caracterAentero2 'Z'  ==  35
caracterAentero2 :: Char -> Integer
caracterAentero2 c = caracteresEnteros M.! c
 
-- caracteresEnteros es el diccionario cuyas claves son los caracteres y
-- las claves son los números de 0 a 35.
caracteresEnteros :: M.Map Char Integer
caracteresEnteros = M.fromList (zip (['0'..'9'] ++ ['A'..'Z']) [0..])
 
decimalAfactoradico2 :: Integer -> String
decimalAfactoradico2 n = aux n (reverse (takeWhile (<=n) facts))
    where aux 0 xs     = ['0' | _ <- xs]
          aux m (x:xs) = enteroAcaracter2 (m `div` x) : aux (m `mod` x) xs
 
-- (enteroAcaracter2 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter2 0   ==  '0'
--    enteroAcaracter2 1   ==  '1'
--    enteroAcaracter2 9   ==  '9'
--    enteroAcaracter2 10  ==  'A'
--    enteroAcaracter2 11  ==  'B'
--    enteroAcaracter2 35  ==  'Z'
enteroAcaracter2 :: Integer -> Char
enteroAcaracter2 k = enterosCaracteres M.! k
 
-- enterosCaracteres es el diccionario cuyas claves son los número de 0
-- a 35 y las claves son los caracteres.
enterosCaracteres :: M.Map Integer Char
enterosCaracteres = M.fromList (zip [0..] caracteres)
 
-- 3ª solución
-- ===========
 
factoradicoAdecimal3 :: String -> Integer
factoradicoAdecimal3 cs =
  sum (zipWith (*) facts (reverse (map caracterAentero3 cs)))
 
-- (caracterAentero3 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero3 '0'  ==  0
--    caracterAentero3 '1'  ==  1
--    caracterAentero3 '9'  ==  9
--    caracterAentero3 'A'  ==  10
--    caracterAentero3 'B'  ==  11
--    caracterAentero3 'Z'  ==  35
caracterAentero3 :: Char -> Integer
caracterAentero3 c =
  genericLength (takeWhile (/= c) caracteres)
 
decimalAfactoradico3 :: Integer -> String
decimalAfactoradico3 n = aux "" 2 (n, 0)
  where aux s _ (0, 0) = s
        aux s n (d, r) = aux (enteroAcaracter3 r: s) (n + 1) (d `divMod` n)
 
-- (enteroAcaracter3 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter3 0   ==  '0'
--    enteroAcaracter3 1   ==  '1'
--    enteroAcaracter3 9   ==  '9'
--    enteroAcaracter3 10  ==  'A'
--    enteroAcaracter3 11  ==  'B'
--    enteroAcaracter3 35  ==  'Z'
enteroAcaracter3 :: Integer -> Char
enteroAcaracter3 n =
  caracteres !! (fromInteger n)
 
-- 4ª solución
-- ===========
 
factoradicoAdecimal4 :: String -> Integer
factoradicoAdecimal4 =
  sum . zipWith (*) facts . reverse . map caracterAentero4
 
-- (caracterAentero4 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero4 '0'  ==  0
--    caracterAentero4 '1'  ==  1
--    caracterAentero4 '9'  ==  9
--    caracterAentero4 'A'  ==  10
--    caracterAentero4 'B'  ==  11
--    caracterAentero4 'Z'  ==  35
caracterAentero4 :: Char -> Integer
caracterAentero4 =
  genericLength . flip takeWhile caracteres . (/=)
 
decimalAfactoradico4 :: Integer -> String
decimalAfactoradico4 = f "" 2 . (, 0)
  where f s _ (0, 0) = s
        f s n (d, r) = f (enteroAcaracter4 r: s) (n + 1) (d `divMod` n)
 
-- (enteroAcaracter4 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter4 0   ==  '0'
--    enteroAcaracter4 1   ==  '1'
--    enteroAcaracter4 9   ==  '9'
--    enteroAcaracter4 10  ==  'A'
--    enteroAcaracter4 11  ==  'B'
--    enteroAcaracter4 35  ==  'Z'
enteroAcaracter4 :: Integer -> Char
enteroAcaracter4 = (caracteres `genericIndex`)
 
-- Propiedad de inverso
-- ====================
 
prop_factoradico :: Integer -> Property
prop_factoradico n =
  n >= 0 ==>
  factoradicoAdecimal1 (decimalAfactoradico1 n) == n &&
  factoradicoAdecimal2 (decimalAfactoradico2 n) == n &&
  factoradicoAdecimal3 (decimalAfactoradico3 n) == n &&
  factoradicoAdecimal4 (decimalAfactoradico4 n) == n
 
-- La comprobación es
--    λ> quickCheck prop_factoradico
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (decimalAfactoradico1 (10^300000))
--    68191
--    (2.46 secs, 9,088,634,744 bytes)
--    λ> length (decimalAfactoradico2 (10^300000))
--    68191
--    (2.36 secs, 9,088,634,800 bytes)
--    λ> length (decimalAfactoradico3 (10^300000))
--    68191
--    (2.18 secs, 4,490,856,416 bytes)
--    λ> length (decimalAfactoradico4 (10^300000))
--    68191
--    (1.98 secs, 4,490,311,536 bytes)
--
--    λ> length (show (factoradicoAdecimal1 (show (10^50000))))
--    213237
--    (0.93 secs, 2,654,156,680 bytes)
--    λ> length (show (factoradicoAdecimal2 (show (10^50000))))
--    213237
--    (0.51 secs, 2,633,367,168 bytes)
--    λ> length (show (factoradicoAdecimal3 (show (10^50000))))
--    213237
--    (0.93 secs, 2,635,792,192 bytes)
--    λ> length (show (factoradicoAdecimal4 (show (10^50000))))
--    213237
--    (0.43 secs, 2,636,996,848 bytes)

El código se encuentra en GitHub.

Leer más →