Visualize integral 2025 as area under the curve (Mathematica)

integral-2025-visualization.wl

@@ -0,0 +1,117 @@
+(* ::Package:: *)
+
+(* =====================================================================
+   Problem 2025:   Integrate[ 4^x / (4^x + 2), {x, 0, 1} ]   ==  1012.5/2025  ==  1/2
+
+   This notebook visualizes the integral as the AREA UNDER THE CURVE,
+   and leverages a few things Mathematica does uniquely well:
+
+     1. Exact symbolic integration (no decimals, no quadrature error).
+     2. A symbolic *proof by symmetry*:   f(x) + f(1-x) == 1,
+        which makes the area exactly 1/2 -- the source of the "1012.5".
+     3. An interactive Manipulate that shades the Riemann area.
+     4. A "reflection" picture showing why the answer is half a unit square.
+   ===================================================================== *)
+
+(* --- The integrand ------------------------------------------------- *)
+f[x_] := 4^x/(4^x + 2)
+
+(* --- 1. Exact value (Mathematica's symbolic engine) ---------------- *)
+exact = Integrate[f[x], {x, 0, 1}]
+(*  ->  1/2   *)
+
+numeric = N[exact, 20]
+(*  ->  0.50000000000000000000   *)
+
+(* Tie it back to the picture in the photo: 2025 * (the integral) *)
+2025 * exact
+(*  ->  2025/2  ==  1012.5   *)
+
+
+(* --- 2. The symmetry that makes it exactly 1/2 --------------------- *)
+(* Claim:  f(x) + f(1 - x) == 1.  Let Mathematica PROVE it symbolically. *)
+symmetryCheck = FullSimplify[f[x] + f[1 - x] == 1]
+(*  ->  True   *)
+
+(* Therefore  2 * Integral = Integral of (f(x)+f(1-x)) dx = Integral of 1 dx = 1. *)
+
+
+(* --- 3. The headline picture: area under the curve ----------------- *)
+areaPlot =
+  Plot[f[x], {x, 0, 1},
+    Filling -> Axis,
+    FillingStyle -> Directive[Opacity[0.35], RGBColor[0.2, 0.5, 0.9]],
+    PlotStyle -> Directive[Thick, RGBColor[0.1, 0.3, 0.7]],
+    PlotRange -> {{0, 1}, {0, 1}},
+    AspectRatio -> 1,
+    AxesLabel -> {"x", "f(x)"},
+    PlotLabel ->
+      Row[{"\[Integral] 4^x/(4^x+2) dx  on  [0,1]  =  ", exact}],
+    Epilog -> {
+      Text[Style["shaded area = 1/2", 14, Bold],
+        {0.55, 0.18}]
+    }
+  ]
+
+
+(* --- 4. Interactive Riemann-sum approximation of the area ---------- *)
+(*    Drag n to watch the rectangles converge to the exact area 1/2.   *)
+riemann =
+  Manipulate[
+    Module[{dx = 1/n, mids, rects, approx},
+      mids = Table[(k - 1/2) dx, {k, 1, n}];
+      approx = dx * Total[f /@ mids];
+      Column[{
+        Show[
+          Plot[f[x], {x, 0, 1}, PlotStyle -> Directive[Thick, Black],
+            PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> 1,
+            AxesLabel -> {"x", "f(x)"}],
+          Graphics[{
+            Opacity[0.4], RGBColor[0.2, 0.5, 0.9],
+            Table[Rectangle[{(k - 1) dx, 0}, {k dx, f[(k - 1/2) dx]}],
+              {k, 1, n}]
+          }]
+        ],
+        Row[{"midpoint Riemann sum (n = ", n, ")  =  ",
+          NumberForm[N[approx], 8],
+          "     exact = ", N[exact]}]
+      }, Center]
+    ],
+    {{n, 8, "rectangles n"}, 1, 200, 1, Appearance -> "Labeled"}
+  ]
+
+
+(* --- 5. Why the area is HALF a unit square (the symmetry, drawn) --- *)
+(*    The region under f on [0,1] and its 180-degree rotation about    *)
+(*    the center (1/2, 1/2) tile the full unit square exactly. So the   *)
+(*    area is half the square = 1/2.                                    *)
+reflectionPicture =
+  Show[
+    Plot[{f[x], 1 - f[1 - x]}, {x, 0, 1},
+      Filling -> {1 -> Axis},
+      FillingStyle -> Directive[Opacity[0.35], RGBColor[0.2, 0.5, 0.9]],
+      PlotStyle -> {
+        Directive[Thick, RGBColor[0.1, 0.3, 0.7]],
+        Directive[Thick, Dashed, RGBColor[0.8, 0.3, 0.2]]
+      },
+      PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> 1,
+      AxesLabel -> {"x", "y"},
+      PlotLabel ->
+        "f(x) and its 180\[Degree] rotation tile the unit square"
+    ],
+    Graphics[{
+      Dashing[{0.01}], Gray, Line[{{0, 1}, {1, 1}, {1, 0}}],
+      Text[Style["area = 1/2", 14, Bold, RGBColor[0.1, 0.3, 0.7]],
+        {0.55, 0.2}],
+      Text[Style["rotated copy", 12, RGBColor[0.8, 0.3, 0.2]],
+        {0.35, 0.78}]
+    }]
+  ]
+
+
+(* --- 6. (Bonus) The exact antiderivative, courtesy of the CAS ------ *)
+antideriv = Integrate[f[x], x]
+(*  Mathematica returns a closed form in terms of Log; differentiate   *)
+(*  to confirm it really is the integrand:                             *)
+checkAntideriv = FullSimplify[D[antideriv, x] == f[x]]
+(*  ->  True   *)