Menu Close

Etiqueta: length

Exponentes de Hamming

Los números de Hamming forman una sucesión estrictamente creciente de números que cumplen las siguientes condiciones:

  • El número 1 está en la sucesión.
  • Si x está en la sucesión, entonces 2x, 3x y 5x también están.
  • Ningún otro número está en la sucesión.

Los primeros números de Hamming son 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, …

Los exponentes de un número de Hamming n es una terna (x,y,z) tal que n = 2^x*3^y*5^z. Por ejemplo, los exponentes de 600 son (3,1,2) ya que 600 = 2^x*3^1*5^z.

Definir la sucesión

   sucExponentesHamming :: [(Int,Int,Int)]

cuyos elementos son los exponentes de los números de Hamming. Por ejemplo,

   λ> take 21 sucExponentesHamming
   [(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),
    (0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),
    (3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]
   λ> sucExponentesHamming !! (5*10^5)
   (74,82,7)

Soluciones

import Data.Numbers.Primes (primeFactors)
 
-- 1ª solución
-- ===========
 
sucExponentesHamming :: [(Int,Int,Int)]
sucExponentesHamming = map exponentes hamming
 
-- (exponentes n) es la terna de exponentes del número de Hamming n. Por
-- ejemplo, 
--    exponentes 600  ==  (3,1,2)
exponentes :: Integer -> (Int,Int,Int)
exponentes x = (length as, length cs, length ds)
  where xs = primeFactors x
        (as,bs) = span (==2) xs
        (cs,ds) = span (==3) bs
 
-- hamming es la sucesión de los números de Hamming. Por ejemplo,
--    λ> take 21 hamming
--    [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]
hamming :: [Integer]
hamming = 1 : mezcla3 [2*i | i <- hamming]  
                      [3*i | i <- hamming]  
                      [5*i | i <- hamming]  
 
-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]  ==  [2,3,4,5,6,8,9,10,12]
mezcla3 :: Ord a => [a] -> [a] -> [a] -> [a]
mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)  
 
-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs e ys y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla2 [2,4,6,8,10,12] [3,6,9,12]  ==  [2,3,4,6,8,9,10,12]
mezcla2 :: Ord a => [a] -> [a] -> [a] 
mezcla2 p@(x:xs) q@(y:ys) | x < y     = x:mezcla2 xs q
                          | x > y     = y:mezcla2 p  ys  
                          | otherwise = x:mezcla2 xs ys
mezcla2 []       ys                   = ys
mezcla2 xs       []                   = xs
 
-- 2ª solución
-- ===========
 
sucExponentesHamming2 :: [(Int,Int,Int)]
sucExponentesHamming2 = map exponentes2 hamming
 
exponentes2 :: Integer -> (Int,Int,Int)
exponentes2 = aux (0,0,0)
  where aux (a,b,c) 1 = (a,b,c)
        aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)
                      | mod x 3 == 0 = aux (a,b+1,c) (div x 3)
                      | otherwise    = aux (a,b,c+1) (div x 5)
 
-- 3ª solución
-- ===========
 
sucExponentesHamming3 :: [(Int,Int,Int)]
sucExponentesHamming3 = map exponentes3 hamming
 
exponentes3 :: Integer -> (Int,Int,Int)
exponentes3 1 = (0,0,0)
exponentes3 x
  | x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))
  | x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))
  | otherwise      = suma (0,0,1) (descomposicion (x `div` 5))
  where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)
 
-- 4ª solución
-- ===========
 
type Terna = (Int,Int,Int)
 
sucExponentesHamming4 :: [Terna]
sucExponentesHamming4 =
  (0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]
 
mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]
mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)
 
mezclaT2 :: [Terna] -> [Terna] -> [Terna]
mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)
  | x < y     = (i,j,k) : mezclaT2 xs ts2
  | x > y     = (a,b,c) : mezclaT2 ts1 ys
  | otherwise = (i,j,k) : mezclaT2 xs ys
  where x = 2^i*3^j*5^k
        y = 2^a*3^b*5^c

Relaciones arbóreas

Como se explica en el ejercicio Relación definida por un árbol, cada árbol binario define una relación binaria donde un elemento x está relacionado con y si x es el padre de y.

Una relación binaria es arbórea si

  • hay exactamente un elemento que no tiene ningún (la raíz del árbol) y
  • todos los elementos tienen dos hijos (los nodos internos) o ninguno (las hojas del árbol).

Definir la función

   arborea :: Eq a => [(a,a)] -> Bool

tal que (arborea r) se verifica si la relación r es arbórea. Por ejemplo,

   arborea [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]  ==  True
   arborea [(8,3),(8,5),(10,2),(2,2),(2,0)]         ==  False
   arborea [(10,8),(8,3),(8,5),(10,2),(8,2),(2,0)]  ==  False

Soluciones

import Data.List ((\\), elemIndices, isPrefixOf, nub, sort)
 
-- 1ª solución
-- ===========
 
arborea :: Eq a => [(a,a)] -> Bool
arborea r =
  length [x | x <- nodos r, null (padres r x)] == 1 &&
  all (`elem` [0,2]) [length (hijos r x) | x <- nodos r]
 
-- (nodos r) es el conjunto de los nodos de la relación r. Por ejemplo,   
--    λ> nodos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]
--    [10,8,3,5,2,0]
nodos :: Eq a => [(a,a)] -> [a]
nodos r = nub (concat [[x,y] | (x,y) <- r])
 
-- (padres r x) es la lista de los padres de x en la relación r. Por
-- ejemplo, 
--    padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 8   ==  [10]
--    padres [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10  ==  []
padres :: Eq a => [(a,a)] -> a -> [a]
padres r x = [y | (y,x') <- r, x' == x]
 
-- (hijos r x) es la lista de los hijos de x en la relación r. Por
-- ejemplo, 
--    hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 10  ==  [8,2]
--    hijos [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)] 5   ==  []
hijos :: Eq a => [(a,a)] -> a -> [a]
hijos r x = [y | (x',y) <- r, x' == x]
 
-- 2ª solución
-- ===========
 
arborea2 :: Eq a => [(a,a)] -> Bool
arborea2 xs =  length (nub padres \\ nub hijos) == 1
            && and [cuenta x padres == 2 | x <- nub padres]
  where
    (padres, hijos) = unzip xs
 
-- (cuenta x ys) es el número de ocurrencias de x en ys. Por ejemplo,
--    cuenta 7 [7,2,7,7,5]  ==  3
cuenta :: Eq a => a -> [a] -> Int
cuenta i = length . elemIndices i

Sucesión de Lichtenberg

La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son

   Alternada ..... Lichtenberg
   0 ....................... 0
   1 ....................... 1
   10 ...................... 2
   101 ..................... 5
   1010 ................... 10
   10101 .................. 21
   101010 ................. 42
   1010101 ................ 85
   10101010 .............. 170
   101010101 ............. 341
   1010101010 ............ 682
   10101010101 .......... 1365
   101010101010 ......... 2730

Definir las funciones

   lichtenberg        :: [Integer]
   graficaLichtenberg :: Int -> IO ()

tales que

  • lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,
     λ> take 17 lichtenberg
     [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]
  • (graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja
    Sucesion_de_Lichtenberg

Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.

Soluciones

import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)
 
-- 1ª solución
-- ===========
 
lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada
 
-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
--    λ> take 7 sucAlternada
--    ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
  ['0'] : [take n cadenaAlternada | n <- [1..]]
 
-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
--    take 20 cadenaAlternada  ==  "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']
 
-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
--    binarioAdecimal "11101"  ==  29
binarioAdecimal :: String -> Integer
binarioAdecimal =
  foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
 
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
  where a 0 = 0
        a 1 = 1
        a n = a (n-1) + 2 * a (n-2) + 1
 
-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
  0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3)) 
 
-- Comprobación de eficiencia
--    λ> length (show (lichtenberg1 !! 27))
--    8
--    (0.02 secs, 155,384 bytes)
--    λ> length (show (lichtenberg2 !! 27))
--    8
--    (2.22 secs, 311,157,760 bytes)
--    
--    λ> length (show (lichtenberg1 !! (8*10^4)))
--    24083
--    (1.28 secs, 664,207,040 bytes)
--    λ> length (show (lichtenberg3 !! (8*10^4)))
--    24083
--    (2.59 secs, 1,253,328,200 bytes)
 
-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
  n > 4 ==> not (isPrime (lichtenberg1 !! n))
 
-- La comprobación es
--    λ> quickCheck propLichtenberg
--    +++ OK, passed 100 tests.
 
graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
  plotList [ Key Nothing
           , Title "Numero de digitos de la sucesion de Lichtenberg"
           , PNG "Sucesion_de_Lichtenberg.png"
           ]
           (take n (map (length . show) lichtenberg1))

Números somirp

Un número omirp es un número primo que forma un primo distinto al invertir el orden de sus dígitos.

Definir las funciones

  esOmirp            :: Integer -> Bool
  omirps             :: [Integer]
  nOmirpsIntermedios :: Int -> Int

tales que

  • (esOmirp n) se verifica si n es un número omirp. Por ejemplo,
     esOmirp 13      ==  True
     esOmirp 11      ==  False
     esOmirp 112207  ==  True
  • omirps es la lista de los números omirps. Por ejemplo,
     take 15 omirps  ==  [13,17,31,37,71,73,79,97,107,113]
     omirps !! 2000  ==  112207
  • (nOmirpsIntermedios n) es la cantidad de números omirps entre el n-ésimo número omirp y el obtenido al invertir el orden de sus dígitos. Por ejemplo,
     nOmirpsIntermedios 2000  ==  4750

Nota: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.Numbers.Primes (isPrime,primes)
 
esOmirp :: Integer -> Bool
esOmirp n = n /= rn && isPrime rn
  where rn = read . reverse . show $ n
 
omirps :: [Integer]
omirps = filter esOmirp primes
 
nOmirpsIntermedios :: Int -> Int
nOmirpsIntermedios n =
  length
  . filter esOmirp
  . takeWhile (< rx)
  . dropWhile (<= x) $ primes
  where x  = omirps !! n
        rx = read . reverse . show $ x

El problema 3SUM

El problem 3SUM consiste en dado una lista xs, decidir si xs posee tres elementos cuya suma sea cero. Por ejemplo, en [7,5,-9,5,2] se pueden elegir los elementos 7, -9 y 2 que suman 0.

Definir las funciones

   sols3Sum :: [Int] -> [[Int]]
   pb3Sum :: [Int] -> Bool

tales que
+ (sols3Sum xs) son las listas de tres elementos de xs cuya suma sea cero. Por ejemplo,

      sols3Sum [8,10,-10,-7,2,-3]   ==  [[-10,2,8],[-7,-3,10]]
      sols3Sum [-2..3]              ==  [[-2,-1,3],[-2,0,2],[-1,0,1]]
      sols3Sum [1,-2]               ==  []
      sols3Sum [-2,1]               ==  []
      sols3Sum [1,-2,1]             ==  [[-2,1,1]]
      length (sols3Sum [-100..100]) ==  5000
  • (pb3Sum xs) se verifica si xs posee tres elementos cuya suma sea cero. Por ejemplo,
     pb3Sum [8,10,-10,-7,2,-3]  ==  True
     pb3Sum [1,-2]              ==  False
     pb3Sum [-2,1]              ==  False
     pb3Sum [1,-2,1]            ==  True
     pb3Sum [1..400]            ==  False

Soluciones

import Data.List
 
-- 1ª solución
-- ===========
 
sols3Sum1 :: [Int] -> [[Int]]
sols3Sum1 = normaliza . sols3Sum1Aux 
 
sols3Sum1Aux :: [Int] -> [[Int]]
sols3Sum1Aux xs =
  [ys | ys <- subsequences xs
      , length ys == 3
      , sum ys == 0]
 
normaliza :: [[Int]] -> [[Int]]
normaliza = sort . nub . map sort
 
pb3Sum1 :: [Int] -> Bool
pb3Sum1 = not . null . sols3Sum1Aux
 
 
-- 2ª solución
-- ===========
 
sols3Sum2 :: [Int] -> [[Int]]
sols3Sum2 = normaliza . sols3Sum2Aux 
 
sols3Sum2Aux :: [Int] -> [[Int]]
sols3Sum2Aux xs =
  [[a,b,c] | (a:bs) <- tails xs
           , (b:cs) <- tails bs
           , c <- cs
           , a + b + c == 0]
 
pb3Sum2 :: [Int] -> Bool
pb3Sum2 = not . null . sols3Sum2Aux
 
-- 3ª solución
-- ===========
 
sols3Sum3 :: [Int] -> [[Int]]
sols3Sum3 = normaliza . sols3Sum3Aux 
 
sols3Sum3Aux :: [Int] -> [[Int]]
sols3Sum3Aux xs =
  [[a,b,-a-b] | (a:bs) <- tails xs
              , b <- bs
              , (-a-b) `elem` (delete a (delete b xs))]
 
pb3Sum3 :: [Int] -> Bool
pb3Sum3 = not . null . sols3Sum3Aux
 
-- Comparación de eficiencia
-- =========================
 
--    λ> pb3Suma [1..23]
--    False
--    (2.61 secs, 1,812,734,176 bytes)
--    λ> pb3Sumb [1..23]
--    False
--    (0.01 secs, 554,496 bytes)
--    λ> pb3Sumc [1..23]
--    False
--    (0.01 secs, 584,344 bytes)
--    λ> pb3Suma ([1..23] ++ [-3]) 
--    True
--    (2.54 secs, 1,812,735,784 bytes)
--    λ> pb3Sumb ([1..23] ++ [-3]) 
--    True
--    (0.01 secs, 148,904 bytes)
--    λ> pb3Sumc ([1..23] ++ [-3]) 
--    True
--    (0.00 secs, 145,320 bytes)
--
--    λ> pb3Sumb [1..300]
--    False
--    (1.66 secs, 933,699,824 bytes)
--    λ> pb3Sumc [1..300]
--    False
--    (0.41 secs, 873,168,120 bytes)