Menu Close

Complemento potencial

El complemento potencial de un número entero positivo x es el menor número y tal que el producto de x por y es un una potencia perfecta. Por ejemplo,

  • el complemento potencial de 12 es 3 ya que 12 y 24 no son potencias perfectas pero 36 sí lo es;
  • el complemento potencial de 54 es 4 ya que 54, 108 y 162 no son potencias perfectas pero 216 = 6^3 sí lo es.

Definir las funciones

   complemento                 :: Integer -> Integer
   graficaComplementoPotencial :: Integer -> IO ()

tales que

  • (complemento x) es el complemento potencial de x; por ejemplo,
     complemento 12     ==  3
     complemento 54     ==  4
     complemento 720    ==  5
     complemento 24000  ==  9
     complemento 2018   ==  2018
  • (graficaComplementoPotencial n) dibuja la gráfica de los complementos potenciales de los n primeros números enteros positivos. Por ejemplo, (graficaComplementoPotencial 100) dibuja
    Complemento_potencial_100
    y (graficaComplementoPotencial 500) dibuja
    Complemento_potencial_500

Comprobar con QuickCheck que (complemento x) es menor o igual que x.

Soluciones

import Data.Numbers.Primes     (primeFactors)
import Data.List               (genericLength, group)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG, Title))
import Test.QuickCheck
 
complemento :: Integer -> Integer
complemento 1 = 1
complemento x =
  head [y | y <- [1..]
          , esPotenciaPerfecta (x*y)]
 
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta x = mcd (exponentes x) > 1
 
-- (exponentes x) es la lista de los exponentes de la factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Integer]
exponentes = map snd . factorizacion
 
-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]
 
-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Integer] -> Integer
mcd = foldl1 gcd
 
-- La propiedad es
prop_complemento :: (Positive Integer) -> Bool
prop_complemento (Positive x) =
  complemento x <= x
 
-- La comprobación es
--    λ> quickCheck prop_complemento
--    +++ OK, passed 100 tests.
 
graficaComplementoPotencial :: Integer -> IO ()
graficaComplementoPotencial n =
  plotList [Key Nothing
           , PNG ("Complemento_potencial_"  ++ show n ++ ".png")
           , Title ("(graficaComplementoPotencial " ++ show n ++ ")") 
           ]
           (map complemento [1..n])

5 soluciones de “Complemento potencial

  1. alerodrod5
    import Test.QuickCheck
    import Data.List
    import Data.Numbers.Primes
     
    complemento :: Integer -> Integer
    complemento x = aux (primeFactors x) 1
      where aux xs n | aux2 ys   = n
                     | otherwise = aux xs (n+1)
              where ys = group (sort (xs ++ primeFactors n))
            aux2 xss
              | null yy   = False
              | otherwise = all (==0) [ y `mod` minimum yy
                                      | y <- map length xss] &&
                            length yy == length (group (sort xss))
                 where yy = [length yss | yss <- xss, length yss/=1]
                       xx = [length yss | yss <-xss] 
     
    graficaComplementoPotencial :: Integer -> IO ()
    graficaComplementoPotencial x =
      plotList [ Title ("(graficaComplementoPotencial" ++""++show x ++")")
               , Key Nothing]
               (take (fromInteger x) complementos)
     
    complementos :: [Integer]
    complementos = map complemento [1..]
     
    propiedad :: Integer -> Property
    propiedad x = x >= 0 ==> complemento x <= x
     
    -- quickCheck propiedad 
    -- +++ OK, passed 100 tests.
  2. carbremor
    import Data.List
    import Test.QuickCheck
    import Graphics.Gnuplot.Simple
     
    complemento :: Integer -> Integer
    complemento x = head [y | y <- [0..], esPerf (x*y)]
     
    graficaComplementoPotencial :: Integer -> IO()
    graficaComplementoPotencial x = plotList [Key Nothing]  (genericTake x (complementos))
     
     
    potenciasPerfectas :: [Integer]
    potenciasPerfectas = [n | n <- [2..] , not (isPrime n) , esPerf n]
     
    esPerf :: Integer -> Bool
    esPerf n = and [gcd x y > 1 | x <- xs , y <- xs]
          where xs = sort (map (length) (group $ primeFactors n))
     
    complementos = [complemento x | x <- [0..]]
     
    -- (complemento x) es menor o igual que x
     
    prop_complemento x =x>=0 ==> complemento x <= x
    -- quickCheck propiedad 
    -- +++ OK, passed 100 tests.
  3. jaiturrod
    complemento :: Integer -> Integer
    complemento x = head[k | k <- [1..], esCuadrado (x*k)]
     
    esCuadrado :: Integer -> Bool
    esCuadrado x = y^2 == x
      where y = round(sqrt(fromIntegral x))
     
    graficaComplementoPotencial :: Integer -> IO()
    graficaComplementoPotencial x = plotList [Key Nothing]  (genericTake x (complementos))
     
    complementos :: [Integer]
    complementos = map complemento [1..]
  4. angruicam1
    import Data.List               (group, sort, nub)
    import Test.QuickCheck
    import Data.Numbers.Primes     (primeFactors)
    import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title))
     
    complemento :: Integer -> Integer
    complemento 1 = 1
    complemento x
      | mcd pfx /= 1 = product (map trc fx)
      | otherwise    =
        minimum
        . map product
        $ zipWith aux (minimosMultiplos pfx) (repeat fx)
                    where fx  = repeticionFactores x
                          pfx = map prm fx
                          aux (l:ls) ((a,b,c):ys) =
                            (b^(l - a) * c) : aux ls ys
                          aux _      _            = []
     
    -- (prm t) es el primer elemento de la terna t. Por ejemplo,
    --    prm (1,2,3)  ==  1
    prm :: (a,b,c) -> a
    prm (a,_,_) = a
     
    -- (trc t) es el tercer elemento de la terna t. Por ejemplo,
    --    trc (1,2,3)  ==  3
    trc :: (a,b,c) -> c
    trc (_,_,c) = c
     
    -- (mcd xs) es el máximo común divisor de los elementos de xs. Por
    -- ejemplo,
    --    mcd [4,8,16]  ==  4
    mcd :: Integral a => [a] -> a
    mcd = foldl1 gcd
     
    -- (minimosMultiplos xs) es la lista de listas obtenidas cogiendo los
    -- distintos factores primos del producto de los elementos de xs y para
    -- cada uno de ellos expresar todos los elementos de xs como los mínimos
    -- múltiplos de dicho primo. Por ejemplo,
    --    minimosMultiplos [2,4,5]  ==  [[2,4,6],[5,5,5]]
    minimosMultiplos :: [Int] -> [[Int]]
    minimosMultiplos xs =
      aux (nub (primeFactors (product xs))) xs
      where aux (y:ys) zs = aux2 y zs : aux ys zs
            aux _      _  = []
            aux2 y (z:zs) =
              until (>= z) (+ y) y : aux2 y zs
            aux2 _ _      = []
     
    -- (repeticionFactores x) es la lista de ternas cuyo primer elemento es
    -- el número de apariciones de un factor primo de x (o múltiplo de
    -- primos que aparezcan el mismo número de veces), el segundo es dicho
    -- factor y el tercero el complemento acumulado (al añadir una vez
    -- aquellos factores primos que sólo aparecen una vez). Por ejemplo,
    --    repeticionFactores (2^2*3^1*7^3)  ==  [(2,6,3),(3,7,1)]
    repeticionFactores :: Integer -> [(Int,Integer, Integer)]
    repeticionFactores =
      aux
      . sort
      . map (ys@(x:xs) ->
               if null xs
               then (2,x,x)
               else (length ys,x,1))
      . group
      . primeFactors
      where aux (x@(a,b,c):y@(d,e,f):xs)
              | a == d    = aux ((a,b*e,c*f):xs)
              | otherwise = x : aux (y:xs)
            aux [x] = [x]
            aux _   = []
     
    -- Gráfica
    -- =======
     
    graficaComplementoPotencial :: Integer -> IO ()
    graficaComplementoPotencial n =
      plotList
      [Title $ "(graficaComplementoPotencial " ++ show n ++ ")",
       Key Nothing]
      (map complemento [1..n])
     
    -- Propiedad
    -- =========
     
    -- La propiedad es
    prop_complemento :: (Positive Integer) -> Bool
    prop_complemento (Positive x) = complemento x <= x
     
    -- La comprobación es
    --    λ> quickCheck prop_complemento
    --    +++ OK, passed 100 tests.
  5. Chema Cortés
    import           Data.List
    import           Data.Numbers.Primes     (primeFactors)
    import           Graphics.Gnuplot.Simple
    import           Test.QuickCheck
     
     
    -- Calcula el número que hay que suma a `m` para alcanzar un múltiplo de `n`
    complementoMCM :: Int -> Int -> Int
    complementoMCM n m | m `mod` n == 0 = 0
                       | otherwise      = n - m `mod` n
     
    complemento :: Integer -> Integer
    complemento n =
      minimum [ product [b^complementoMCM p k | (b,k) <- fs] | p <- ms]
      where
        fs = [(head xs, length xs) | xs <- (group . primeFactors) n]
        ms = nub $ 2 : (filter (>1) . map snd) fs

Leave a Reply

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.