Terna pitagórica a partir de un lado

6 Comentarios

1. Haskell

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

   1 2 3 4 5 6 7 8 9 10 11 12 13 14

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

   Responder

2. Haskell

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

   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

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

   Responder

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

   Haskell

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

   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

   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.

   Responder

4. Haskell

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

   1 2 3 4 5 6 7 8 9 10

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

   Responder

5. Haskell

   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

   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54

   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

   Responder

   1. Falta un detallito en la función ternasPrimasImpares:

      Haskell

      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)

      1 2 3 4 5 6 7 8 9

      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)

      Responder