Una terna pitagórica con primer lado x es una terna (x,y,z) tal que x^2 + y^2 = z^2. Por ejemplo, las ternas pitagóricas con primer lado 16 son (16,12,20), (16,30,34) y (16,63,65).
(graficaMayorHipotenusa n) dibuja la gráfica de las sucesión de las mayores hipotenusas de las ternas pitagóricas con primer lado x, para x entre 3 y n. Por ejemplo, (graficaMayorHipotenusa 100) dibuja
Soluciones
import Graphics.Gnuplot.Simple
-- Definición de ternasPitagoricas-- ===============================
ternasPitagoricas ::Integer->[(Integer,Integer,Integer)]
ternasPitagoricas x =[(x,y,z)| y <-[1..(x^2-1) `div` 2]
, z <- raizCuadrada (x^2+ y^2)]-- La justificación de la cota es-- x > 2-- x^2 + y^2 >= (y+1)^2-- x^2 + y^2 >= y^2 + 2*y + 1-- y =< (x^ 2 - 1) `div` 2 -- (raizCuadrada x) es la lista formada por la raíz cuadrada entera de-- x, si existe y la lista vacía, en caso contrario. Por ejemplo, -- raizCuadrada 25 == [5]-- raizCuadrada 26 == []
raizCuadrada ::Integer->[Integer]
raizCuadrada x =[y | y <-[(round . sqrt . fromIntegral) x]
, y^2== x]-- 1ª definición de mayorTernaPitagorica-- =====================================
mayorTernaPitagorica ::Integer->(Integer,Integer,Integer)
mayorTernaPitagorica =last . ternasPitagoricas
-- 2ª definición de mayorTernaPitagorica-- =====================================
mayorTernaPitagorica2 ::Integer->(Integer,Integer,Integer)
mayorTernaPitagorica2 x =head[(x,y,z)| y <-[k, k-1 .. 1]
, z <- raizCuadrada (x^2+ y^2)]where k =(x^2-1) `div` 2-- 3ª definición de mayorTernaPitagorica-- =====================================-- Se supone que x > 2. Se consideran dos casos:-- -- Primer caso: Supongamos que x es par. Entonces x^2 > 4 y es divisible-- por 4. Por tanto, existe un y tal que x^2 = 4*y + 4; luego,-- x^2 + y^2 = 4*y + 4 + y^2-- = (y + 2)^2-- La terna es (x,y,y+2) donde y = (x^2 - 4) / 4.---- Segundo caso: Supongamos que x es impar. Entonces x^2 es impar. Por-- tanto, existe un y tal que x^2 = 2*y + 1; luego,-- x^2 + y^2 = 2*y + 1 + y^2-- = (y+1)^2-- La terna es (x,y,y+1) donde y = (x^2 - 1) / 2.
mayorTernaPitagorica3 ::Integer->(Integer,Integer,Integer)
mayorTernaPitagorica3 x
|even x =(x, y1, y1 +2)|otherwise=(x, y2, y2 +1)where y1 =(x^2-4) `div` 4
y2 =(x^2-1) `div` 2-- Comparación de eficiencia-- λ> mayorTernaPitagorica 1006-- (1006,253008,253010)-- (7.36 secs, 1,407,793,992 bytes)-- λ> mayorTernaPitagorica2 1006-- (1006,253008,253010)-- (3.76 secs, 704,007,456 bytes)-- λ> mayorTernaPitagorica3 1006-- (1006,253008,253010)-- (0.01 secs, 157,328 bytes)
graficaMayorHipotenusa ::Integer->IO()
graficaMayorHipotenusa n =
plotList [ Key Nothing
, PNG "Terna_pitagorica_a_partir_de_un_lado.png"][(x,z)| x <-[3..n]
, let(_,_,z)= mayorTernaPitagorica3 x]
import Graphics.Gnuplot.Simple
-- Definición de ternasPitagoricas
-- ===============================
ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas x =
[(x,y,z) | y <- [1..(x^ 2 - 1) `div` 2 ]
, z <- raizCuadrada (x^2 + y^2)]
-- La justificación de la cota es
-- x > 2
-- x^2 + y^2 >= (y+1)^2
-- x^2 + y^2 >= y^2 + 2*y + 1
-- y =< (x^ 2 - 1) `div` 2
-- (raizCuadrada x) es la lista formada por la raíz cuadrada entera de
-- x, si existe y la lista vacía, en caso contrario. Por ejemplo,
-- raizCuadrada 25 == [5]
-- raizCuadrada 26 == []
raizCuadrada :: Integer -> [Integer]
raizCuadrada x =
[y | y <- [(round . sqrt . fromIntegral) x]
, y^2 == x]
-- 1ª definición de mayorTernaPitagorica
-- =====================================
mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica =
last . ternasPitagoricas
-- 2ª definición de mayorTernaPitagorica
-- =====================================
mayorTernaPitagorica2 :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica2 x =
head [(x,y,z) | y <- [k, k-1 .. 1]
, z <- raizCuadrada (x^2 + y^2)]
where k = (x^2 - 1) `div` 2
-- 3ª definición de mayorTernaPitagorica
-- =====================================
-- Se supone que x > 2. Se consideran dos casos:
--
-- Primer caso: Supongamos que x es par. Entonces x^2 > 4 y es divisible
-- por 4. Por tanto, existe un y tal que x^2 = 4*y + 4; luego,
-- x^2 + y^2 = 4*y + 4 + y^2
-- = (y + 2)^2
-- La terna es (x,y,y+2) donde y = (x^2 - 4) / 4.
--
-- Segundo caso: Supongamos que x es impar. Entonces x^2 es impar. Por
-- tanto, existe un y tal que x^2 = 2*y + 1; luego,
-- x^2 + y^2 = 2*y + 1 + y^2
-- = (y+1)^2
-- La terna es (x,y,y+1) donde y = (x^2 - 1) / 2.
mayorTernaPitagorica3 :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica3 x
| even x = (x, y1, y1 + 2)
| otherwise = (x, y2, y2 + 1)
where y1 = (x^2 - 4) `div` 4
y2 = (x^2 - 1) `div` 2
-- Comparación de eficiencia
-- λ> mayorTernaPitagorica 1006
-- (1006,253008,253010)
-- (7.36 secs, 1,407,793,992 bytes)
-- λ> mayorTernaPitagorica2 1006
-- (1006,253008,253010)
-- (3.76 secs, 704,007,456 bytes)
-- λ> mayorTernaPitagorica3 1006
-- (1006,253008,253010)
-- (0.01 secs, 157,328 bytes)
graficaMayorHipotenusa :: Integer -> IO ()
graficaMayorHipotenusa n =
plotList [ Key Nothing
, PNG "Terna_pitagorica_a_partir_de_un_lado.png"
]
[(x,z) | x <- [3..n]
, let (_,_,z) = mayorTernaPitagorica3 x]
Otra propuesta de solución buscando las ternas pitagóricas a partir de las ternas primitivas, inspirada en el artículo Generando ternas pitagoricas publicado el 23 de marzo de 2009 por Miguel Ángel Morales en su blog Gaussianos.
import Data.List (group, inits, sort, nub)import Data.Numbers.Primes (primeFactors, isPrime)import Graphics.Gnuplot.Simple (plotList, Attribute (Key))
ternasPitagoricas ::Integer->[(Integer,Integer,Integer)]
ternasPitagoricas 1=[]
ternasPitagoricas n = sort . nub $ aux n (ternasPrimitivas n)where aux _ []=[]
aux n ((x,y,z):xs)=let m = n `div` x in(n,y * m,z * m): aux n xs
-- (ternasPrimitivas n) es la lista de ternas pitagóricas primitivas de-- n a partir de las cuales se obtienen las ternas pitagóricas de n. Por-- ejemplo,-- ternasPrimitivas 25 == [(25,312,313),(5,12,13)]
ternasPrimitivas ::Integer->[(Integer,Integer,Integer)]
ternasPrimitivas n
|even n =[(n,x^2- y^2,x^2+ y^2)| x <-[1..n `div` 2]
, y <-[1..x-1]
, x * y == n `div` 2]++(concatMap ternasPrimitivas (divisoresPropios n))| isPrime n =[(n,(n^2-1) `div` 2,(n^2+1) `div` 2)]|otherwise=[(n,(x^2- y^2) `div` 2,(x^2+ y^2) `div` 2)| x <-[1..n]
, y <-[1..x -1]
, x * y == n]++(concatMap ternasPrimitivas (divisoresPropios n))-- (divisoresPropios n) es la lista de divisores propios de n. Por-- ejemplo,-- divisoresPropios 16 == [2,4,8]
divisoresPropios ::Integer->[Integer]
divisoresPropios =tail
. init
. sort
. map(product . concat)
. producto
. map(inits)
. group
. primeFactors
-- (producto xss) es producto cartesiano de la familia de conjuntos xss.-- Por ejemplo,-- producto [[1,2],[3,4]] == [[1,3],[1,4],[2,3],[2,4]]
producto ::[[a]]->[[a]]
producto =foldr f [[]]where f xs xss =[x:ys | x <- xs, ys <- xss]
mayorTernaPitagorica ::Integer->(Integer,Integer,Integer)
mayorTernaPitagorica x
|odd x =(x,x2,x2 +1)|otherwise=(x,x2 `div` 2-1,x2 `div` 2+1)where x2 = x^2 `div` 2
graficaMayorHipotenusa ::Integer->IO()
graficaMayorHipotenusa n =
plotList [Key Nothing][((_,_,z)-> z) . mayorTernaPitagorica $ x | x <-[3..n]]
import Data.List (group, inits, sort, nub)
import Data.Numbers.Primes (primeFactors, isPrime)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key))
ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas 1 = []
ternasPitagoricas n = sort . nub $ aux n (ternasPrimitivas n)
where aux _ [] = []
aux n ((x,y,z):xs) =
let m = n `div` x in (n,y * m,z * m) : aux n xs
-- (ternasPrimitivas n) es la lista de ternas pitagóricas primitivas de
-- n a partir de las cuales se obtienen las ternas pitagóricas de n. Por
-- ejemplo,
-- ternasPrimitivas 25 == [(25,312,313),(5,12,13)]
ternasPrimitivas :: Integer -> [(Integer,Integer,Integer)]
ternasPrimitivas n
| even n =
[(n,x^2 - y^2,x^2 + y^2)
| x <- [1..n `div` 2]
, y <- [1..x-1]
, x * y == n `div` 2]
++ (concatMap ternasPrimitivas (divisoresPropios n))
| isPrime n =
[(n,(n^2 - 1) `div` 2,(n^2 + 1) `div` 2)]
| otherwise =
[(n,(x^2 - y^2) `div` 2,(x^2 + y^2) `div` 2)
| x <- [1..n]
, y <- [1..x - 1]
, x * y == n]
++ (concatMap ternasPrimitivas (divisoresPropios n))
-- (divisoresPropios n) es la lista de divisores propios de n. Por
-- ejemplo,
-- divisoresPropios 16 == [2,4,8]
divisoresPropios :: Integer -> [Integer]
divisoresPropios =
tail
. init
. sort
. map (product . concat)
. producto
. map (inits)
. group
. primeFactors
-- (producto xss) es producto cartesiano de la familia de conjuntos xss.
-- Por ejemplo,
-- producto [[1,2],[3,4]] == [[1,3],[1,4],[2,3],[2,4]]
producto :: [[a]] -> [[a]]
producto = foldr f [[]]
where f xs xss = [x:ys | x <- xs, ys <- xss]
mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica x
| odd x = (x,x2,x2 + 1)
| otherwise = (x,x2 `div` 2 - 1,x2 `div` 2 + 1)
where x2 = x^2 `div` 2
graficaMayorHipotenusa :: Integer -> IO ()
graficaMayorHipotenusa n =
plotList [Key Nothing]
[((_,_,z) -> z) . mayorTernaPitagorica $ x | x <- [3..n]]
Nota: En la definición de ternasPrimitivas pueden aparecer ternas no primitivas o repetidas pero esos casos se solucionan mediante el “nub” de la función ternasPitagoricas.
import Data.Numbers.Primes
import Data.List
ternasPitagoricas ::Integer->[(Integer,Integer,Integer)]
ternasPitagoricas n =(aux.tail.divisores) n
where aux []=[]
aux (x:xs)|even x =(f.ternasPrimasPares) x ++ aux xs
|otherwise=(f.ternasPrimasImpares) x ++ aux xs
where f []=[]
f ((x,y,z):xs)=(n,d*y,d*z):(f xs)
d = n `div` x
divisores ::Integer->[Integer]
divisores = aux.group.primeFactors
where aux []=[1]
aux (x:xs)=concat[map(*(u^k)) t | k<-[0..length x], let u =head x, let t = aux xs]-- Ternas primas para enteros impares --
ternasPrimasImpares ::Integer->[(Integer,Integer,Integer)]
ternasPrimasImpares n =[(n, 2*v*u, v^2+u^2)| p<-algoritmoNImpar n, let v =max(fst p)(snd p), let u =min(fst p)(snd p)]
algoritmoNImpar ::Integer->[(Integer,Integer)]
algoritmoNImpar n =[(fromIntegral(round v),u)| u<-[1..(n`div` 2)], let v =(sqrt(fromIntegral(n+u^2))), v ==fromIntegral(round v)]-- Ternas primas para enteros pares --
ternasPrimasPares ::Integer->[(Integer,Integer,Integer)]
ternasPrimasPares n =[(n, v^2-u^2, v^2+u^2)| p<-algoritmoNPar n, let v =max(fst p)(snd p), let u =min(fst p)(snd p)]
algoritmoNPar ::Integer->[(Integer,Integer)]
algoritmoNPar n |odd n2 =[]|otherwise=zip aux (map(n2 `div`) aux)where aux = partesPrimas n2
n2 = n `div` 2
partesPrimas ::Integer->[Integer]
partesPrimas n = aux (tail t)((head h)^(fromIntegral$length h))where t = group $ primeFactors n
h =head t
aux [] v =[v]
aux (d:divs) v = aux2 ++map(*(head d)^(length d)) aux2
where aux2 = aux divs v
-- Mayor terna pitagórica --
mayorTernaPitagorica ::Integer->(Integer,Integer,Integer)
mayorTernaPitagorica n |even n =(n,e,e+2)|otherwise=(n,o,o+1)where e =(n^2-4) `div` 4
o =(n^2-1) `div` 2
import Data.Numbers.Primes
import Data.List
ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas n = (aux.tail.divisores) n
where aux [] = []
aux (x:xs) | even x = (f.ternasPrimasPares) x ++ aux xs
| otherwise = (f.ternasPrimasImpares) x ++ aux xs
where f [] = []
f ((x,y,z):xs) = (n,d*y,d*z):(f xs)
d = n `div` x
divisores :: Integer -> [Integer]
divisores = aux.group.primeFactors
where aux [] = [1]
aux (x:xs) = concat [map (*(u^k)) t | k<-[0..length x], let u = head x, let t = aux xs]
-- Ternas primas para enteros impares --
ternasPrimasImpares :: Integer -> [(Integer,Integer,Integer)]
ternasPrimasImpares n = [(n, 2*v*u, v^2+u^2) | p<-algoritmoNImpar n, let v = max (fst p) (snd p), let u = min (fst p) (snd p)]
algoritmoNImpar :: Integer -> [(Integer,Integer)]
algoritmoNImpar n = [(fromIntegral(round v),u) | u<-[1..(n`div` 2)], let v = (sqrt(fromIntegral(n+u^2))), v == fromIntegral(round v)]
-- Ternas primas para enteros pares --
ternasPrimasPares :: Integer -> [(Integer,Integer,Integer)]
ternasPrimasPares n = [(n, v^2-u^2, v^2+u^2) | p<-algoritmoNPar n, let v = max (fst p) (snd p), let u = min (fst p) (snd p)]
algoritmoNPar :: Integer -> [(Integer,Integer)]
algoritmoNPar n | odd n2 = []
| otherwise = zip aux (map (n2 `div`) aux)
where aux = partesPrimas n2
n2 = n `div` 2
partesPrimas :: Integer -> [Integer]
partesPrimas n = aux (tail t) ((head h)^(fromIntegral $ length h))
where t = group $ primeFactors n
h = head t
aux [] v = [v]
aux (d:divs) v = aux2 ++ map (*(head d)^(length d)) aux2
where aux2 = aux divs v
-- Mayor terna pitagórica --
mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica n | even n = (n,e,e+2)
| otherwise = (n,o,o+1)
where e = (n^2 - 4) `div` 4
o = (n^2 - 1) `div` 2
Falta un detallito en la función ternasPrimasImpares:
ternasPrimasImpares ::Integer->[(Integer,Integer,Integer)]
ternasPrimasImpares n =[(n, 2*v*u, v^2+u^2)| p<-algoritmoNImpar n, let v =max(fst p)(snd p), let u =min(fst p)(snd p), gcd v u ==1]wheregcd a 0= a
gcd a b =gcd b (a `mod` b)-- EFICIENCIA:-- λ> length (ternasPitagoricas 479001600)-- 4702-- (1.58 secs, 845,795,424 bytes)
ternasPrimasImpares :: Integer -> [(Integer,Integer,Integer)]
ternasPrimasImpares n = [(n, 2*v*u, v^2+u^2) | p<-algoritmoNImpar n, let v = max (fst p) (snd p), let u = min (fst p) (snd p), gcd v u == 1]
where gcd a 0 = a
gcd a b = gcd b (a `mod` b)
-- EFICIENCIA:
-- λ> length (ternasPitagoricas 479001600)
-- 4702
-- (1.58 secs, 845,795,424 bytes)
José A. Alonso
Otra propuesta de solución buscando las ternas pitagóricas a partir de las ternas primitivas, inspirada en el artículo Generando ternas pitagoricas publicado el 23 de marzo de 2009 por Miguel Ángel Morales en su blog Gaussianos.
Nota: En la definición de ternasPrimitivas pueden aparecer ternas no primitivas o repetidas pero esos casos se solucionan mediante el “nub” de la función ternasPitagoricas.
Falta un detallito en la función ternasPrimasImpares: