Menu Close

Cálculo de pi mediante los métodos de Gregory-Leibniz y de Beeler

La fórmula de Gregory-Leibniz para calcular pi es
Calculo_de_pi_mediante_los_metodos_de_Gregory-Leibniz_y_de_Beeler_1
y la de Beeler es
Calculo_de_pi_mediante_los_metodos_de_Gregory-Leibniz_y_de_Beeler_2

Definir las funciones

   aproximaPiGL     :: Int -> Double
   aproximaPiBeeler :: Int -> Double
   graficas         :: [Int] -> IO ()

tales que

  • (aproximaPiGL n) es la aproximación de pi con los primeros n términos de la fórmula de Gregory-Leibniz. Por ejemplo,
     aproximaPiGL 1       ==  4.0
     aproximaPiGL 2       ==  2.666666666666667
     aproximaPiGL 3       ==  3.466666666666667
     aproximaPiGL 10      ==  3.0418396189294032
     aproximaPiGL 100     ==  3.1315929035585537
     aproximaPiGL 1000    ==  3.140592653839794
     aproximaPiGL 10000   ==  3.1414926535900345
     aproximaPiGL 100000  ==  3.1415826535897198
  • (aproximaPiBeeler n) es la aproximación de pi con los primeros n términos de la fórmula de Beeler. Por ejemplo,
     aproximaPiBeeler 1   ==  2.0
     aproximaPiBeeler 2   ==  2.6666666666666665
     aproximaPiBeeler 3   ==  2.933333333333333
     aproximaPiBeeler 10  ==  3.140578169680337
     aproximaPiBeeler 60  ==  3.141592653589793
     pi                   ==  3.141592653589793
  • (graficas xs) dibuja la gráfica de las k-ésimas aproximaciones de pi, donde k toma los valores de la lista xs, con las fórmulas de Gregory-Leibniz y de Beeler. Por ejemplo, (graficas [1..25]) dibuja
    Calculo_de_pi_mediante_los_metodos_de_Gregory-Leibniz_y_de_Beeler_3
    donde la línea morada corresponde a la aproximación de Gregory-Leibniz y la verde a la de Beeler.

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

import Graphics.Gnuplot.Simple
 
-- Definiciones de aproximaPiGL
-- ============================
 
-- 1ª definición de aproximaPiGL
aproximaPiGL :: Int -> Double
aproximaPiGL n = 4 * (sum . take n . sumaA . zipWith (/) [1,1..]) [1,3..]
  where sumaA (x:y:xs) = x:(-y):sumaA xs
 
-- 2ª definición de aproximaPiGL
aproximaPiGL2 :: Int -> Double
aproximaPiGL2 n =
  4 * (sum (take n (zipWith (/) (cycle [1,-1]) [1,3..])))
 
-- 3ª definición de aproximaPiGL
aproximaPiGL3 :: Int -> Double
aproximaPiGL3 n =
  4 * (sum . take n . zipWith (/) (cycle [1,-1])) [1,3..]
 
-- 4ª definición de aproximaPiGL
aproximaPiGL4 :: Int -> Double
aproximaPiGL4 n = serieGL !! (n-1)
 
serieGL :: [Double]
serieGL = scanl1 (+) (zipWith (/) numeradores denominadores)
  where numeradores   = cycle [4,-4]
        denominadores = [1,3..]
 
-- Definición de aproximaPiBeeler
aproximaPiBeeler :: Int -> Double
aproximaPiBeeler n = 2 * aux (fromIntegral n) 1
  where
    aux :: Double -> Double -> Double 
    aux n k | n == k    = 1
            | otherwise = 1 + (k/(2*k+1)) * aux n (1+k)
 
-- Definición de graficas
graficas :: [Int] -> IO ()
graficas xs = 
    plotLists [Key Nothing]
             [[(k,aproximaPiGL k)     | k <- xs],
              [(k,aproximaPiBeeler k) | k <- xs]]
Medio

8 soluciones de “Cálculo de pi mediante los métodos de Gregory-Leibniz y de Beeler

  1. albcercid
    aproximaPiGL :: Int -> Double
    aproximaPiGL n = 4*aux 1 3 1
          where aux a b c | a == n = c
                          | even a = aux (a+1) (b+2) (1/b+c)
                          | otherwise = aux (a+1) (b+2) (-1/b+c)
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2.0*aux 1 3
          where aux a b | a == n = 1
                        | otherwise = 1.0+(fromIntegral a)/(fromIntegral b)*aux (a+1) (b+2)
     
     
    graficas :: [Int] -> IO ()
    graficas xs = plotLists [] [a,b]
         where a = [aproximaPiGL x | x <- xs]
               b = [aproximaPiBeeler x | x <- xs]
  2. ignareeva
    aproximaPiGL  :: Int -> Double
    aproximaPiGL n = 4* (foldl1 (+) (take n (listaPiGL)))
     
    listaPiGL = zipWith (/) xs ys
    ys = [ x | x <- [1,3..]]
    xs = 1 : (-1) : xs
     
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2 * (beeler zs)
      where zs = take n (zip (repeat 1) listaPiBeeler)
     
    listaPiBeeler = zipWith (/) rs ts
               where rs = [x | x <- [1..]]
                     ts = [y | y <- [3,5..]]
     
    beeler [] = 0
    beeler zs = fst (head zs) + (snd (head zs) * beeler (tail zs))
  3. antdursan
    aproximaPiGL     :: Int -> Double
    aproximaPiGL n = 4*sum [(-1)^x/((2*(fromIntegral x))+1) | x <- [0..n-1]]
     
     
     
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2 * fraccion 1 3
                            where fraccion x y | x == n = 1
                                               | otherwise = 1 + (fromIntegral x)/(fromIntegral y)*(fraccion (x+1) (y+2))
     
     
     
    graficas         :: [Int] -> IO ()
    graficas xs = plotLists [] [x,y]
                  where x = [aproximaPiBeeler n | n <- xs]
                        y = [aproximaPiGL n | n <- xs]
  4. enrnarbej
    aproximaPiGL:: Int -> Double
    aproximaPiGL n = 4 * (sum . take n . sumaA . zipWith (/) [1,1..]) [1,3..]
             where sumaA (x:y:xs) = x:(-y):sumaA xs
     
    aproximaPiBeeler  :: Double -> Double
    aproximaPiBeeler  n = 2 * aux n 1
            where
             aux n k | n == k = 1
                     | otherwise = 1+ (k/(2*k+1))*aux n (1+k)
  5. eliguivil
    aproximaPiGL     :: Int -> Double
    aproximaPiGL n = 4*(aux1 $ take n [1,3..])
      where
        aux1 []     = 0
        aux1 (x:xs) = 1/x    + aux2 xs
        aux2 []     = 0
        aux2 (x:xs) = (-1)/x + aux1 xs
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2* (aux (take n [3,5..]) 1)
      where
        aux [x]    k  = 1 + k/x
        aux (x:xs) k  = 1 + (k/x * aux xs (k+1))
     
    graficas :: [Int] -> IO ()
    graficas ns = plotLists [] [xs,ys]
      where
        xs = [(x,aproximaPiGL     x) | x <- ns]
        ys = [(x,aproximaPiBeeler x) | x <- ns]
  6. marlobrip
    import Graphics.Gnuplot.Simple
     
    aproximaPiGl :: Int -> Double
    aproximaPiGl n = 4*sum [x*(1/y) | (x,y) <- zip unos (take n [1,3..]) ]
             where unos = 1: iterate (*(-1)) (-1)
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2 * (1 + aux (f [1..]) (f [3,5..]))
         where f = take (n-1)
                   aux (x:xs) (y:ys) = x/y * (1 + aux xs ys)
                   aux [] _ = 0
     
    graficas :: [Int] -> IO ()
    graficas zs  =  plotLists [] [xs, ys]
           where xs = [(x,aproximaPiBeeler x) | x <- zs ]
                 ys = [(y,aproximaPiGl y) | y <- zs]
  7. paumacpar
    aproximaPiGL :: Int -> Double
    aproximaPiGL n = 4* (aux2 sucImp 1)
      where aux2 (x:xs) k | k == n = (fromRational x)
                          |otherwise = (fromRational x)+ (aux2 xs (k+1))
     
    sucImp :: [Rational]
    sucImp = [1%b | b <- auxSigno [1,3..]]
      where auxSigno (x:y:xs) = x: ((-1)*y): auxSigno xs 
     
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2*(aux3 [1..] [3,5..] 1)
      where aux3 (x:xs) (y:ys) k | k == n = 1
                                 | otherwise = 1 + ((x/y)*(aux3 xs ys (k+1)))
  8. Juanjo Ortega (juaorture)
    import Graphics.Gnuplot.Simple
     
    aproximaPiGL :: Int -> Double
    aproximaPiGL n = 4 * sum [(signo k) * (1/fromIntegral k) | k <- [1,3..2*n]]
                 where signo n | n `mod` 4 == 1 = 1
                               | n `mod` 4 == 3 = -1
     
    aproximaPiBeeler :: Int -> Double
    aproximaPiBeeler n = 2 * aux 1 3
                     where fI = fromIntegral
                           aux x y | x < n     = 1 + (fI x)/(fI y) * aux (x+1) (y+2)
                                   | otherwise = 1
     
    graficas :: [Int] -> IO ()
    graficas xs = plotLists [Key Nothing] [ l aproximaPiGL , l aproximaPiBeeler]
             where l f = zip xs $ map f xs

Escribe tu solución

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