|
| 1 | +# Simpson's Rule for Numerical Integration |
| 2 | +# |
| 3 | +# Simpson's Rule is a method for numerical integration that approximates |
| 4 | +# the definite integral of a function using quadratic polynomials. |
| 5 | +# It provides better accuracy than the trapezoidal rule by using parabolic |
| 6 | +# arcs instead of straight line segments. |
| 7 | +# |
| 8 | +# Time Complexity: O(n) where n is the number of subintervals |
| 9 | +# Space Complexity: O(n) for storing the x values |
| 10 | +# |
| 11 | +# Applications: |
| 12 | +# - Numerical integration in scientific computing |
| 13 | +# - Physics and engineering calculations |
| 14 | +# - Signal processing and data analysis |
| 15 | +# - Probability and statistics (computing areas under curves) |
| 16 | +# - Computer graphics and visualization |
| 17 | +# |
| 18 | +# Formula: ∫[a,b] f(x)dx ≈ (h/3)[f(x₀) + 4f(x₁) + 2f(x₂) + 4f(x₃) + ... + f(xₙ)] |
| 19 | +# where h = (b-a)/n and n must be even |
| 20 | + |
| 21 | +simpson_rule <- function(f, a, b, n) { |
| 22 | + #' Approximate the definite integral of f(x) from a to b using Simpson's Rule |
| 23 | + #' @param f: Function to integrate |
| 24 | + #' @param a: Lower limit of integration (numeric) |
| 25 | + #' @param b: Upper limit of integration (numeric) |
| 26 | + #' @param n: Number of subintervals (must be even) |
| 27 | + #' @return: Approximation of the integral (numeric) |
| 28 | + #' @details Simpson's Rule uses parabolic approximations to estimate the |
| 29 | + #' area under a curve. The interval [a,b] is divided into n |
| 30 | + #' subintervals, and quadratic interpolation is applied. |
| 31 | + #' @references https://en.wikipedia.org/wiki/Simpson%27s_rule |
| 32 | + |
| 33 | + # Validate that n is even |
| 34 | + if (n %% 2 != 0) { |
| 35 | + stop("Error: Number of subintervals n must be even for Simpson's Rule.") |
| 36 | + } |
| 37 | + |
| 38 | + # Validate inputs |
| 39 | + if (!is.numeric(a) || !is.numeric(b) || !is.numeric(n)) { |
| 40 | + stop("Error: a, b, and n must be numeric values.") |
| 41 | + } |
| 42 | + |
| 43 | + if (n <= 0) { |
| 44 | + stop("Error: Number of subintervals n must be positive.") |
| 45 | + } |
| 46 | + |
| 47 | + if (a >= b) { |
| 48 | + stop("Error: Lower limit a must be less than upper limit b.") |
| 49 | + } |
| 50 | + |
| 51 | + # Calculate step size |
| 52 | + h <- (b - a) / n |
| 53 | + |
| 54 | + # Generate x values |
| 55 | + x <- seq(a, b, by = h) |
| 56 | + |
| 57 | + # Initialize result with endpoints |
| 58 | + result <- f(x[1]) + f(x[n + 1]) |
| 59 | + |
| 60 | + # Apply Simpson's coefficients |
| 61 | + # Odd indices (i = 3, 5, 7, ...) get coefficient 4 |
| 62 | + # Even indices (i = 2, 4, 6, ...) get coefficient 2 |
| 63 | + for (i in 2:n) { |
| 64 | + if (i %% 2 != 0) { |
| 65 | + # Odd index: multiply by 4 |
| 66 | + result <- result + 4 * f(x[i]) |
| 67 | + } else { |
| 68 | + # Even index: multiply by 2 |
| 69 | + result <- result + 2 * f(x[i]) |
| 70 | + } |
| 71 | + } |
| 72 | + |
| 73 | + # Multiply by h/3 |
| 74 | + result <- result * h / 3 |
| 75 | + |
| 76 | + return(result) |
| 77 | +} |
| 78 | + |
| 79 | +# Vectorized version for better performance |
| 80 | +simpson_rule_vectorized <- function(f, a, b, n) { |
| 81 | + #' Vectorized implementation of Simpson's Rule |
| 82 | + #' @param f: Function to integrate (must support vectorized input) |
| 83 | + #' @param a: Lower limit of integration |
| 84 | + #' @param b: Upper limit of integration |
| 85 | + #' @param n: Number of subintervals (must be even) |
| 86 | + #' @return: Approximation of the integral |
| 87 | + |
| 88 | + if (n %% 2 != 0) { |
| 89 | + stop("Error: Number of subintervals n must be even.") |
| 90 | + } |
| 91 | + |
| 92 | + h <- (b - a) / n |
| 93 | + x <- seq(a, b, by = h) |
| 94 | + y <- f(x) |
| 95 | + |
| 96 | + # Create coefficient vector: [1, 4, 2, 4, 2, ..., 2, 4, 1] |
| 97 | + coefficients <- rep(2, n + 1) |
| 98 | + coefficients[1] <- 1 |
| 99 | + coefficients[n + 1] <- 1 |
| 100 | + coefficients[seq(2, n, by = 2)] <- 4 |
| 101 | + |
| 102 | + result <- sum(coefficients * y) * h / 3 |
| 103 | + return(result) |
| 104 | +} |
| 105 | + |
| 106 | +# Helper function to print integration results |
| 107 | +print_integration_result <- function(f, a, b, n, result, exact = NULL) { |
| 108 | + #' Print formatted integration results |
| 109 | + #' @param f: Function that was integrated |
| 110 | + #' @param a: Lower limit |
| 111 | + #' @param b: Upper limit |
| 112 | + #' @param n: Number of subintervals |
| 113 | + #' @param result: Computed integral value |
| 114 | + #' @param exact: Exact value if known (optional) |
| 115 | + |
| 116 | + cat("Simpson's Rule Integration:\n") |
| 117 | + cat(sprintf(" Interval: [%.4f, %.4f]\n", a, b)) |
| 118 | + cat(sprintf(" Subintervals: %d\n", n)) |
| 119 | + cat(sprintf(" Approximate integral: %.10f\n", result)) |
| 120 | + |
| 121 | + if (!is.null(exact)) { |
| 122 | + error <- abs(result - exact) |
| 123 | + rel_error <- error / abs(exact) * 100 |
| 124 | + cat(sprintf(" Exact value: %.10f\n", exact)) |
| 125 | + cat(sprintf(" Absolute error: %.2e\n", error)) |
| 126 | + cat(sprintf(" Relative error: %.4f%%\n", rel_error)) |
| 127 | + } |
| 128 | + cat("\n") |
| 129 | +} |
| 130 | + |
| 131 | +# ========== Example Usage ========== |
| 132 | + |
| 133 | +cat("========== Example 1: Integral of sin(x) from 0 to π ==========\n\n") |
| 134 | + |
| 135 | +# Define the function to integrate |
| 136 | +func1 <- function(x) sin(x) |
| 137 | + |
| 138 | +# Integration limits |
| 139 | +a1 <- 0 |
| 140 | +b1 <- pi |
| 141 | + |
| 142 | +# Number of subintervals (must be even) |
| 143 | +n1 <- 10 |
| 144 | + |
| 145 | +# Calculate integral |
| 146 | +integral1 <- simpson_rule(func1, a1, b1, n1) |
| 147 | +exact1 <- 2.0 # Exact value of ∫sin(x)dx from 0 to π is 2 |
| 148 | + |
| 149 | +print_integration_result(func1, a1, b1, n1, integral1, exact1) |
| 150 | + |
| 151 | +# ========== Example 2: Integral of x² from 0 to 1 ========== |
| 152 | + |
| 153 | +cat("========== Example 2: Integral of x² from 0 to 1 ==========\n\n") |
| 154 | + |
| 155 | +func2 <- function(x) x^2 |
| 156 | +a2 <- 0 |
| 157 | +b2 <- 1 |
| 158 | +n2 <- 20 |
| 159 | + |
| 160 | +integral2 <- simpson_rule(func2, a2, b2, n2) |
| 161 | +exact2 <- 1/3 # Exact value is 1/3 |
| 162 | + |
| 163 | +print_integration_result(func2, a2, b2, n2, integral2, exact2) |
| 164 | + |
| 165 | +# ========== Example 3: Integral of e^x from 0 to 1 ========== |
| 166 | + |
| 167 | +cat("========== Example 3: Integral of e^x from 0 to 1 ==========\n\n") |
| 168 | + |
| 169 | +func3 <- function(x) exp(x) |
| 170 | +a3 <- 0 |
| 171 | +b3 <- 1 |
| 172 | +n3 <- 10 |
| 173 | + |
| 174 | +integral3 <- simpson_rule(func3, a3, b3, n3) |
| 175 | +exact3 <- exp(1) - 1 # Exact value is e - 1 |
| 176 | + |
| 177 | +print_integration_result(func3, a3, b3, n3, integral3, exact3) |
| 178 | + |
| 179 | +# ========== Example 4: Comparison with different n values ========== |
| 180 | + |
| 181 | +cat("========== Example 4: Convergence study for sin(x) ==========\n\n") |
| 182 | + |
| 183 | +n_values <- c(10, 20, 50, 100, 200) |
| 184 | +cat("Convergence of Simpson's Rule with increasing subintervals:\n") |
| 185 | +cat(sprintf("%-15s %-20s %-15s\n", "Subintervals", "Approximate", "Error")) |
| 186 | +cat(strrep("-", 50), "\n") |
| 187 | + |
| 188 | +for (n in n_values) { |
| 189 | + result <- simpson_rule(sin, 0, pi, n) |
| 190 | + error <- abs(result - 2.0) |
| 191 | + cat(sprintf("%-15d %-20.12f %.4e\n", n, result, error)) |
| 192 | +} |
| 193 | +cat("\n") |
| 194 | + |
| 195 | +# ========== Example 5: Using vectorized version ========== |
| 196 | + |
| 197 | +cat("========== Example 5: Vectorized implementation ==========\n\n") |
| 198 | + |
| 199 | +func5 <- function(x) 1 / (1 + x^2) # Arctangent derivative |
| 200 | +a5 <- 0 |
| 201 | +b5 <- 1 |
| 202 | +n5 <- 100 |
| 203 | + |
| 204 | +integral5 <- simpson_rule_vectorized(func5, a5, b5, n5) |
| 205 | +exact5 <- pi / 4 # ∫[0,1] 1/(1+x²)dx = arctan(1) - arctan(0) = π/4 |
| 206 | + |
| 207 | +print_integration_result(func5, a5, b5, n5, integral5, exact5) |
| 208 | + |
| 209 | +# ========== Example 6: Gaussian function ========== |
| 210 | + |
| 211 | +cat("========== Example 6: Gaussian (Normal) distribution PDF ==========\n\n") |
| 212 | + |
| 213 | +# Standard normal distribution PDF from -3 to 3 |
| 214 | +gaussian <- function(x) (1 / sqrt(2 * pi)) * exp(-x^2 / 2) |
| 215 | +a6 <- -3 |
| 216 | +b6 <- 3 |
| 217 | +n6 <- 100 |
| 218 | + |
| 219 | +integral6 <- simpson_rule(gaussian, a6, b6, n6) |
| 220 | +# Exact value is approximately 0.9973 (99.73% within 3 standard deviations) |
| 221 | + |
| 222 | +cat(sprintf("Integral of standard normal PDF from %.1f to %.1f: %.6f\n", a6, b6, integral6)) |
| 223 | +cat(sprintf("This represents %.2f%% of the total area under the curve.\n\n", integral6 * 100)) |
| 224 | + |
| 225 | +# ========== Notes ========== |
| 226 | +cat("========== Important Notes ==========\n") |
| 227 | +cat("1. Simpson's Rule requires an EVEN number of subintervals.\n") |
| 228 | +cat("2. It provides O(h⁴) accuracy (fourth-order accurate).\n") |
| 229 | +cat("3. More accurate than Trapezoidal Rule for smooth functions.\n") |
| 230 | +cat("4. Works best for continuous, smooth functions.\n") |
| 231 | +cat("5. For higher accuracy, increase the number of subintervals.\n") |
0 commit comments