Menu Close

Terna pitagórica a partir de un lado

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

Definir las funciones

   ternasPitagoricas      :: Integer -> [(Integer,Integer,Integer)]
   mayorTernaPitagorica   :: Integer -> (Integer,Integer,Integer)
   graficaMayorHipotenusa :: Integer -> IO ()

tales que

  • (ternasPitgoricas x) es la lista de las ternas pitagóricas con primer lado x. Por ejemplo,
     ternasPitagoricas 16 == [(16,12,20),(16,30,34),(16,63,65)]
     ternasPitagoricas 20 == [(20,15,25),(20,21,29),(20,48,52),(20,99,101)]
     ternasPitagoricas 25 == [(25,60,65),(25,312,313)]
     ternasPitagoricas 26 == [(26,168,170)]
  • (mayorTernaPitagorica x) es la mayor de las ternas pitagóricas con primer lado x. Por ejemplo,
     mayorTernaPitagorica 16     ==  (16,63,65)
     mayorTernaPitagorica 20     ==  (20,99,101)
     mayorTernaPitagorica 25     ==  (25,312,313)
     mayorTernaPitagorica 26     ==  (26,168,170)
     mayorTernaPitagorica 2018   ==  (2018,1018080,1018082)
     mayorTernaPitagorica 2019   ==  (2019,2038180,2038181)
  • (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
    Terna_pitagorica_a_partir_de_un_lado

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]

6 soluciones de “Terna pitagórica a partir de un lado

  1. albcarcas1
     
     
    ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
    ternasPitagoricas x = [(x,y,z) | z <- [1..x^2],  
                                     y <- [1..z], 
                                     x^2+y^2==z^2]
     
    mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
    mayorTernaPitagorica x = head[(x,y,z) | ((x,y,z),a) <- zip (ternasPitagoricas x) (sumaTerna x), 
                                             a== maximum(sumaTerna x)]
    sumaTerna :: Integer -> [Integer]
    sumaTerna x = [sum[y,z] | (x,y,z) <- ternasPitagoricas x]
     
     
    graficaMayorHipotenusa :: Integer -> IO ()
    graficaMayorHipotenusa n = plotList [Title "Gráfica Mayor Hipotenusa", XLabel "Lado de partida", YLabel "Mayor hipotenusa", Key Nothing] ([z | x <- [3..n], (x,y,z) <- [mayorTernaPitagorica x]])
  2. angruicam1
    import Graphics.Gnuplot.Simple (plotList, Attribute (Key))
     
    ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
    ternasPitagoricas x =
      [(x,y,z) | z <- [raizCuadrada x2..x2],
       let y = raizCuadrada (z^2 - x2),
           z^2 - y^2 == x2, y /= 0]
      where x2           = x^2
            raizCuadrada = floor . sqrt . fromIntegral
     
    mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
    mayorTernaPitagorica x =
      head [(x,y,z) | z <- [x2,x2 - 1..raizCuadrada x2],
            let y = raizCuadrada (z^2 - x2),
                z^2 - y^2 == x2]
      where x2             = x^2
            raizCuadrada   = floor . sqrt . fromIntegral
     
    graficaMayorHipotenusa :: Integer -> IO ()
    graficaMayorHipotenusa n =
      plotList [Key Nothing]
      [((_,_,z) -> z) . mayorTernaPitagorica $ x | x <- [3..n]]
  3. angruicam1

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

    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.

  4. carbremor
    ternasPitagoricas :: Integer -> [(Integer, Integer, Integer)]
    ternasPitagoricas a = [(a,b,c) | c <- [a+1..(a^2+1) `div` 2]
                                   , let b = (round . sqrt . fromIntegral) (c^2 - a^2)
                                   , a^2 + b^2 == c^2]
     
    mayorTernaPitagorica   :: Integer -> (Integer,Integer,Integer)
    mayorTernaPitagorica a = maximum (ternasPitagoricas a)
     
    graficaMayorHipotenusa :: Integer -> IO ()
    graficaMayorHipotenusa n = plotList [] ([z | x <- [3..n], (x,y,z) <- [mayorTernaPitagorica x]])
  5. jaibengue
    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
    • jaibengue

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

Leave a Reply

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