Complemento potencial

PorJosé A. Alonso 22-enero-201829-enero-2018

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 ()

1 2	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

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

y (graficaComplementoPotencial 500) dibuja

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])

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 Comentarios

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.

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.

Responder

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.

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.

Responder

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..]

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..]

Responder

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.

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.

Responder

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

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

Responder

5 Comentarios

Leave a Reply to carbremorCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

5 Comentarios

Leave a Reply to carbremorCancel reply

Entradas recientes

Buscar

Correo electrónico