(* This package may be distributed freely, but is copyright by Lafayette College, 1994. *) BeginPackage["IntegralGraphics`"] rightrect::usage="rightrect[f[x],{x,a,b,n}] draws right-hand endpoint rectangles." leftrect::usage="leftrect[f[x],{x,a,b,n}] draws left-hand endpoint rectangles." midrect::usage="midrect[f[x],{x,a,b,n}] draws mid-point rectangles." trapezoid::usage="trapezoid[f[x],{x,a,b,n}] draws trapezoids." error::usage="error[estimate] computes the error between estimate and the area of the region under consideration." Begin["`Private`"] box[x_,y_,h_] = Graphics[{RGBColor[0,0,1], Line[{{x, 0},{x, y}, {x + h, y}, {x + h, 0}}]}]; rightrect[func_,paramlist_] := Module[{boxes, curve, k, a, b, h, n, param, x}, param = paramlist[[1]]; a = N[paramlist[[2]]]; b = N[paramlist[[3]]]; n = N[paramlist[[4]]]; h = (b - a)/n; boxes = Table[box[a + k h,func /. param->(a + k h),-h], {k,1,n}]; curve = Plot[func /. param -> x,{x,a,b}, PlotStyle->RGBColor[1,0,0],DisplayFunction->Identity]; Show[{boxes,curve}, DisplayFunction -> $DisplayFunction, Axes -> True, AxesOrigin -> {a,0}] ] leftrect[func_,paramlist_] := Module[{boxes, curve, k, a, b, h, n, param, x}, param = paramlist[[1]]; a = N[paramlist[[2]]]; b = N[paramlist[[3]]]; n = N[paramlist[[4]]]; h = (b - a)/n; boxes = Table[box[a + k h,func /. param->(a + k h),h], {k,0,n-1}]; curve = Plot[func /. param -> x,{x,a,b}, PlotStyle->RGBColor[1,0,0],DisplayFunction->Identity]; Show[boxes,curve, DisplayFunction -> $DisplayFunction, Axes -> True, AxesOrigin -> {a,0}] ] midrect[func_,paramlist_] := Block[{boxes, curve, k, a, b, h, n, param, x}, param = paramlist[[1]]; a = N[paramlist[[2]]]; b = N[paramlist[[3]]]; n = N[paramlist[[4]]]; h = (b - a)/n; boxes = Table[box[a + k h,func /. param->(a + (k-0.5)h), -h], {k,1,n}]; curve = Plot[func /. param -> x,{x,a,b}, PlotStyle->RGBColor[1,0,0],DisplayFunction->Identity]; Show[boxes,curve, DisplayFunction -> $DisplayFunction, Axes -> True,AxesOrigin -> {a,0}] ] trap[x0_,y0_,x1_,y1_] = Graphics[{RGBColor[0,0,1], Line[{{x0,0},{x0,y0},{x1,y1},{x1,0}}]}]; trapezoid[func_,paramlist_] := Module[{boxes, curve, k, a, b, h, n, param, x}, param = paramlist[[1]]; a = N[paramlist[[2]]]; b = N[paramlist[[3]]]; n = N[paramlist[[4]]]; h = (b - a)/n; boxes = Table[trap[a + k h,func /. param ->(a + k h), a + (k+1)h,func /. param ->(a + (k+1)h)],{k,0,n-1}]; curve = Plot[func /. param -> x,{x,a,b}, PlotStyle->RGBColor[1,0,0],DisplayFunction->Identity]; Show[boxes,curve, DisplayFunction -> $DisplayFunction, Axes -> True, AxesOrigin -> {a,0}] ] error[est_] := est - Log[2.0] End[(*Private*)] EndPackage[]