{NotebookFileName[],DateString[]}

style[
t_
]:=
Style[t,Bold,FontFamily->"Arial",FontSize->14]

$Assumptions={{x,y}∈Reals}

Exponential decay example

We have a sample of radioactive material. For once, I’ll choose things so that results will be round numbers. The decay rate at time 0 is 100 (s^(-1)), and the half life is 1000 s. Problem: determine how many nuclei have decayed after 2000 s?

The decay rate at time t is f(t)=100×(2^(-t/1000)). The number that decay between time t and t+Δ t is approximately f(t)Δ t (using a left-hand rule). This is the area of a rectangle of width Δ t and height f(t).

f1[
t_,
d0_:100,
th_:1000
]:=
d0 (2^(-t/th));
f1[t]

lhrects[
n_,
tmin_:0.0,
tmax_:4000.,
f_:f1
]:=Module[{dt=((tmax-tmin)/n)},
Table[
Rectangle[{tmin+(i-1) dt,0},{tmin+i dt,f[tmin+(i-1)dt]}],
{i,n}
]
]

lhrects[4]

Graphics[{
EdgeForm[Directive[Thick,Black]],Pink,
lhrects[4]
}
,AspectRatio->Full
,PlotRange->All
,PlotRangePadding->Scaled[.05]
,PlotRangeClipping->False
]

rhrects[
n_,
tmin_:0.0,
tmax_:4000.,
f_:f1
]:=Module[{dt=((tmax-tmin)/n)},
Table[
Rectangle[{tmin+(i-1) dt,0},{tmin+i dt,f[tmin+i dt]}],
{i,n}
]
]

rhrects[4]

Graphics[{
EdgeForm[Directive[Thick,Black]],Pink,
rhrects[4]
}
,AspectRatio->Full
,PlotRange->All
,PlotRangePadding->Scaled[.05]
,PlotRangeClipping->False
]

lhsum[
n_,
tmin_:0.0,
tmax_:4000.,
f_:f1
]:=Module[{dt=((tmax-tmin)/n)},
Sum[
f[tmin+(i-1)dt]dt,
{i,n}
]
]

lhsum[4]

rhsum[
n_,
tmin_:0.0,
tmax_:4000.,
f_:f1
]:=Module[{dt=((tmax-tmin)/n)},
Sum[
f[tmin+i dt]dt,
{i,n}
]
]

rhsum[4]

Block[{tmin=0,tmax=4000,n=4},
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
,PlotLegends->style/@{"decay rate"}
]
]

Block[{tmin=0,tmax=4000,n=4},
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,PlotLegends->style/@{"decay rate"}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n][[1]]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
]
]

Block[{tmin=0,tmax=4000,n=4,lha},
lha=lhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]]
}]
]
]

Block[{tmin=0,tmax=4000,n=8,lha},
lha=lhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]]
}]
]
]

Block[{tmin=0,tmax=4000,n=64,lha},
lha=lhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]]
}]
]
]

(∫_0^4000)f1[t]\[DifferentialD]t

(∫_0^4000)f1[t]\[DifferentialD]t//N

Limit[(400000/n)((1-(2^(-4)))/(1-(2^(-4/n)))),n->∞]//FullSimplify

D[1-(2^(-2/n)),n]

Block[{tmin=0,tmax=4000,n=4,rha},
rha=rhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][3],EdgeForm[Black],rhrects[n]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
],
SwatchLegend[
{ColorData[97,3]},
style/@{
"RH rule area = "<>ToString[N[rha]]
}
]
]
]

SwatchLegend[{ColorData[97][2],ColorData[97,3]},style/@{"LH rule","RH rule"}]

ScientificForm[N@4000*f1[1000],1]

Block[{is=400,tmin=0,tmax=4000,n=4,dt,lha,rha,pad=500},
dt=((tmax-tmin)/n);
lha=lhsum[n,tmin,tmax];
rha=rhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n,tmin,tmax]},
{ColorData[97][3],EdgeForm[Black],rhrects[n,tmin,tmax]},
{ColorData[97][4],EdgeForm[Black],Rectangle[{tmax+pad,f1[tmax]},{tmax+pad+dt,f1[tmin]}]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
,FrameTicks->{Range[0,4000,1000],Automatic}
,PlotRangePadding->{{Automatic,pad+dt},{Automatic,Automatic}}
,ImageSize->is
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]],
"RH rule area = "<>ToString[N[rha]],
"LH - RH area = "<>ToString[N[lha-rha]]
}]
]
]

Block[{is=400,tmin=0,tmax=4000,n=4,dt,lha,rha,pad=500},
dt=((tmax-tmin)/n);
lha=lhsum[n,tmin,tmax];
rha=rhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n,tmin,tmax]}(*,
{ColorData[97][3],EdgeForm[Black],rhrects[n,tmin,tmax]}(*,
{ColorData[97][4],EdgeForm[Black],Rectangle[{tmax+pad,f1[tmax]},{tmax+pad+dt,f1[tmin]}]}*)*)
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
,FrameTicks->{Range[0,4000,1000],Automatic}
,PlotRangePadding->{{Automatic,Automatic},{Automatic,Automatic}}
,ImageSize->is
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]](*,
"RH rule area = "<>ToString[N[rha]],
"LH - RH area = "<>ToString[N[lha-rha]]*)
}]
]
]

Block[{is=400,tmin=0,tmax=4000,n=8,dt,lha,rha,pad=500},
dt=((tmax-tmin)/n);
lha=lhsum[n,tmin,tmax];
rha=rhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n,tmin,tmax]},
{ColorData[97][3],EdgeForm[Black],rhrects[n,tmin,tmax]},
{ColorData[97][4],EdgeForm[Black],Rectangle[{tmax+pad,f1[tmax]},{tmax+pad+dt,f1[tmin]}]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
,FrameTicks->{Range[0,4000,1000],Automatic}
,PlotRangePadding->{{Automatic,pad+dt},{Automatic,Automatic}}
,ImageSize->is
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
{
"LH rule area = "<>ToString[N[lha]],
"RH rule area = "<>ToString[N[rha]],
"LH - RH area = "<>ToString[N[lha-rha]]
}]
]
]

Block[{is=400,tmin=0,tmax=4000,n=32,dt,lha,rha,pad=500},
dt=((tmax-tmin)/n);
lha=lhsum[n,tmin,tmax];
rha=rhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n,tmin,tmax]},
{ColorData[97][3],EdgeForm[Black],rhrects[n,tmin,tmax]},
{ColorData[97][4],EdgeForm[Black],Rectangle[{tmax+pad,f1[tmax]},{tmax+pad+dt,f1[tmin]}]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
,FrameTicks->{Range[0,4000,1000],Automatic}
,PlotRangePadding->{{Automatic,pad+dt},{Automatic,Automatic}}
,ImageSize->is
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
{
"LH rule area = "<>ToString[N[lha]],
"RH rule area = "<>ToString[N[rha]],
"LH - RH area = "<>ToString[N[lha-rha]]
}]
]
]

|

Block[{is=400,tmin=0,tmax=4000,n=64,dt,lha,rha,pad=500},
dt=((tmax-tmin)/n);
lha=lhsum[n,tmin,tmax];
rha=rhsum[n,tmin,tmax];
Legended[
Plot[f1[t],{t,tmin,tmax}
,PlotStyle->{Thick,Black}
,Prolog->{
{ColorData[97][2],EdgeForm[Black],lhrects[n,tmin,tmax]},
{ColorData[97][3],EdgeForm[Black],rhrects[n,tmin,tmax]},
{ColorData[97][4],EdgeForm[Black],Rectangle[{tmax+pad,f1[tmax]},{tmax+pad+dt,f1[tmin]}]}
}
,Frame->{{True,False},{True,False}}
,FrameLabel->{{style["decays/s"],None},{style["t (s)"],None}}
,FrameTicks->{Range[0,4000,1000],Automatic}
,PlotRangePadding->{{Automatic,pad+dt},{Automatic,Automatic}}
,ImageSize->is
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
{
"LH rule area = "<>ToString[N[lha]],
"RH rule area = "<>ToString[N[rha]],
"LH - RH area = "<>ToString[N[lha-rha]]
}]
]
]

∫f1[t]\[DifferentialD]t

∫(2^(-t/τ))\[DifferentialD]t

∫(2^(-t/τ))\[DifferentialD]t/.{{t->0},{t->4000}}

Subtract@@(∫(2^(-t/τ))\[DifferentialD]t/.{{t->0},{t->4000}})

Subtract@@(∫(2^(-t/τ))\[DifferentialD]t/.{{t->0},{t->4000}}) //Simplify

Integral of the normal distribution

Show[
Plot[PDF[NormalDistribution[],x],{x,-3,3}
,PlotLegends->style/@{PDF[NormalDistribution[],x]}
],
Plot[PDF[NormalDistribution[],x],{x,-3,1}
,PlotStyle->Opacity[0]
,Filling->Bottom
]
]

Estimating π by numerical quadrature

(∫_0^1)(1/((x^2)+1))\[DifferentialD]x

Plot[(1/((x^2)+1)),{x,0,1}
,PlotRange->{0,All}
,AspectRatio->Automatic
]

(∫_0^2)(Sqrt[4-(x^2)])\[DifferentialD]x

∫(Sqrt[4-(x^2)])\[DifferentialD]x

Plot[(Sqrt[4-(x^2)]),{x,0,2}
,AspectRatio->Automatic
,Filling->Bottom
,PlotLegends->style/@{(Sqrt[4-(x^2)])}
,Epilog->{
Text[style["A = π"],{0.75,0.75}]
}
,Frame->{{True,False},{True,False}}
]

Plot[(Sqrt[4-(x^2)]),{x,0,1}
,AspectRatio->Automatic
,PlotRange->{0,All}
]

(∫_0^1)(Sqrt[4-(x^2)])\[DifferentialD]x-((Sqrt[3])/2)//Simplify

fc[
x_
]:=
(Sqrt[4-(x^2)])

midrects[
n_,
tmin_:0.0,
tmax_:4000.,
f_:f1
]:=Module[{dt=((tmax-tmin)/n)},
Table[
Rectangle[{tmin+(i-1) dt,0},{tmin+i dt,f[tmin+(i-(1/2))dt]}],
{i,n}
]
]

Graphics[{
EdgeForm[Black],
{ColorData[97][2],
lhrects[10,0,2,fc]},
{ColorData[97][3],
midrects[10,0,2,fc]},
{ColorData[97][4],
rhrects[10,0,2,fc]}
}]

?lhsum

midsum[
n_,
tmin_:0.,
tmax_:4000.,
f_:f1
]:=Module[{dt=((tmax-tmin)/n)},
Sum[f[tmin+(i-(1/2))dt]dt,{i,n}]
]

simpsum[
n_,
tmin_:0.,
tmax_:4000.,
f_:f1
]:=Module[{nn,dt,vals,coeffs},
nn=If[OddQ[n],n+1,n];
dt=((tmax-tmin)/nn);
vals=Table[f[tmin+i dt],{i,0,nn}];
coeffs=Flatten[{1,4,ConstantArray[{2,4},(nn/2)-1],1}];
vals.coeffs((dt/3))
]

simpsum[10,0,2,fc]

Block[{n=10,xm=2,a,labels,vals,errs},
a=(∫_0^xm)fc[x]\[DifferentialD]x;
labels={
"LH",
"RH",
"trap",
"mid",
"simp"
};
vals={
lhsum[n,0,xm,fc],
rhsum[n,0,xm,fc],
((lhsum[n,0,xm,fc]+rhsum[10,0,2,fc])/2),
midsum[n,0,xm,fc],
simpsum[n,0,xm,fc]
};
errs=vals-a;
Thread[labels->Transpose[{vals,errs}]]
]//Column//N

Block[{n=20,xm=2,a,labels,vals,errs},
a=(∫_0^xm)fc[x]\[DifferentialD]x;
labels={
"LH",
"RH",
"trap",
"mid",
"simp"
};
vals={
lhsum[n,0,xm,fc],
rhsum[n,0,xm,fc],
((lhsum[n,0,xm,fc]+rhsum[10,0,2,fc])/2),
midsum[n,0,xm,fc],
simpsum[n,0,xm,fc]
};
errs=vals-a;
Thread[labels->Transpose[{vals,errs}]]
]//Column//N

Block[{n=20,xm=1,a,labels,vals,errs},
a=(∫_0^xm)fc[x]\[DifferentialD]x;
labels={
"LH",
"RH",
"trap",
"mid",
"simp"
};
vals={
lhsum[n,0,xm,fc],
rhsum[n,0,xm,fc],
((lhsum[n,0,xm,fc]+rhsum[10,0,2,fc])/2),
midsum[n,0,xm,fc],
simpsum[n,0,xm,fc]
};
errs=vals-a;
Thread[labels->Transpose[{vals,errs}]]
]//Column//N

Block[{n=10,lha,rha},
lha=lhsum[n,0,2,fc];
rha=rhsum[n,0,2,fc];
Legended[
Show[
Graphics[{
EdgeForm[Black],
{ColorData[97][2],
lhrects[10,0,2,fc]},
{ColorData[97][3],
rhrects[10,0,2,fc]}
}],
Plot[fc[x],{x,0,2}
,AspectRatio->Automatic
,PlotStyle->Directive[Thick,Black]
,PlotLegends->style/@{(Sqrt[4-(x^2)])}
]
,Frame->{{True,False},{True,False}}
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]],
"RH rule area = "<>ToString[N[rha]]
}]
]
]

Clear[parabolas];
parabolas[
n_,
tmin_:0.,
tmax_:4000.,
f_:f1
]:=Module[{nn,dt,ts,vals,tsegs,vsegs,t,wt},
nn=If[OddQ[n],n+1,n];
dt=((tmax-tmin)/nn);
ts=Table[tmin+i dt,{i,0,nn}];
vals=f/@ts;
tsegs=Partition[ts,3,2];
vsegs=Partition[vals,3,2];
wt=Flatten[
Table[
{
tsegs[[i,1]]≤t≤tsegs[[i,3]],
ListInterpolation[vsegs[[i]],tsegs[[i]],InterpolationOrder->2][t]
},
{i,Length[vsegs]}
]
];
Function@@{t,
Which@@Evaluate[wt]}
]

Block[{xmin=0,xmax=2,n=10,pf},
pf=parabolas[n,xmin,xmax,fc];
Plot[{fc[x],pf[x]},{x,xmin,xmax}
,AspectRatio->Automatic
]
]

Clear[trapezoids];
trapezoids[
n_,
tmin_:0.,
tmax_:4000.,
f_:f1
]:=Module[{nn=n,dt,ts,vals,tsegs,vsegs,t,wt},
dt=((tmax-tmin)/nn);
ts=Table[tmin+i dt,{i,0,nn}];
vals=f/@ts;
tsegs=Partition[ts,2,1];
vsegs=Partition[vals,2,1];
wt=Flatten[
Table[
{
tsegs[[i,1]]≤t≤tsegs[[i,2]],
ListInterpolation[vsegs[[i]],tsegs[[i]],InterpolationOrder->1][t]
},
{i,Length[vsegs]}
]
];
Function@@{t,
Which@@Evaluate[wt]}
]

Block[{xmin=0,xmax=2,n=10,tf},
tf=trapezoids[n,xmin,xmax,fc];
Legended[
Plot[{fc[x],tf[x]},{x,xmin,xmax}
,PlotStyle->{Directive[Thick,Black],Directive[Thick,Blue]}
,Filling->{2->{1}}
,AspectRatio->Automatic
,PlotLegends->style/@{
(Sqrt[4-(x^2)]),
"trapezoids"
}
],
SwatchLegend[
{Lighter[Blue,0.7]},
style/@{
"trapezoid rule error"
}]
]
]

Block[{n=10,lha,rha,trapa,xmin=0,xmax=2,f=fc,tf},
lha=lhsum[n,xmin,xmax,f];
rha=rhsum[n,xmin,xmax,f];
trapa=((lha+rha)/2);
tf=trapezoids[n,xmin,xmax,f];
Legended[
Show[
Graphics[{
EdgeForm[Black],
{ColorData[97][2],
lhrects[n,xmin,xmax,f]},
{ColorData[97][3],
rhrects[n,xmin,xmax,f]}
}],
Plot[{
f[x],
tf[x]
},{x,0,2}
,AspectRatio->Automatic
,PlotStyle->{
Directive[Thick,Black],Directive[Thick,Blue]
}
,PlotLegends->style/@{(Sqrt[4-(x^2)]),"trapezoids"}
]
,Frame->{{True,False},{True,False}}
],
SwatchLegend[
{ColorData[97][2],ColorData[97,3],ColorData[97,4]},
style/@{
"LH rule area = "<>ToString[N[lha]],
"RH rule area = "<>ToString[N[rha]],
"trapezoid rule area = "<>ToString[N[trapa]]
}]
]
]

Block[{n=10,lha,rha,trapa,mida,xmin=0,xmax=2,f=fc,tf},
mida=midsum[n,xmin,xmax,f];
Legended[
Show[
Graphics[{
EdgeForm[Black],
{ColorData[97][4],
midrects[n,xmin,xmax,f]}
}],
Plot[{
f[x]
},{x,0,2}
,AspectRatio->Automatic
,PlotStyle->{
Directive[Thick,Black],Directive[Thick,Blue]
}
,PlotLegends->style/@{(Sqrt[4-(x^2)]),"trapezoids"}
]
,Frame->{{True,False},{True,False}}
],
SwatchLegend[
{ColorData[97,4]},
style/@{
"midpoint rule area = "<>ToString[N[mida]],
}]
]
]

Clear[rectangles];
rectangles[
n_,
tmin_:0.,
tmax_:4000.,
f_:f1
]:=Module[{nn=n,dt,ts,vals,tsegs,t,wt},
dt=((tmax-tmin)/nn);
ts=Table[tmin+i dt,{i,0,nn}];
vals=f/@ts;
tsegs=Partition[ts,2,1];
wt=Flatten[
Table[
{
tsegs[[i,1]]≤t≤tsegs[[i,2]],
f[((tsegs[[i,1]]+tsegs[[i,2]])/2)]
},
{i,Length[tsegs]}
]
];
Function@@{t,
Which@@Evaluate[wt]}
]

Block[{xmin=0,xmax=2,n=10,rf},
rf=rectangles[n,xmin,xmax,fc];
Legended[
Plot[{fc[x],rf[x]},{x,xmin,xmax}
,AspectRatio->Automatic
,PlotStyle->{Directive[Thick,Black],Directive[Thick,Blue]}
,Exclusions->None
,Filling->{2->{1}}
,PlotLegends->style/@{
(Sqrt[4-(x^2)]),
"midpoint rectangles"
}
],
SwatchLegend[
{Lighter[Blue,0.7]},
style/@{
"midpoint rule error"
}]
]
]

Block[{xmin=0,xmax=2,n=10,pf},
pf=parabolas[n,xmin,xmax,fc];
Legended[
Plot[{fc[x],pf[x]},{x,xmin,xmax}
,AspectRatio->Automatic
,PlotStyle->{Directive[Thick,Black],Directive[Thick,Blue]}
,Exclusions->None
,Filling->{2->{1}}
,PlotLegends->style/@{
(Sqrt[4-(x^2)]),
"parabolas"
}
],
SwatchLegend[
{Lighter[Blue,0.7]},
style/@{
"Simpson's rule error"
}]
]
]

Block[{xmin=0,xmax=1,n=10,pf},
Legended[
Plot[{fc[x]},{x,xmin,xmax}
,AspectRatio->Automatic
,PlotRange->{{xmin,xmax},{0,All}}
,PlotStyle->{Directive[Thick,Black]}
,Exclusions->None
,Filling->{1->Axis}
,PlotLegends->style/@{
(Sqrt[4-(x^2)]),
"parabolas"
}
,Epilog->{
EdgeForm[Directive[Thick,Blue]],Lighter[Blue,0.7],
Triangle[{{xmin,0},{xmax,0},{xmax,fc[xmax]}}]
}
],
SwatchLegend[
{Lighter[Black,0.7],Lighter[Blue,0.7]},
style/@{
"A = (π/3)","A = ((Sqrt[3])/2)"
}]
]
]

Block[{n=10,xm=1,labels,vals,errs},
labels={
"LH",
"RH",
"trap",
"mid",
"simp"
};
vals={
lhsum[n,0,xm,fc],
rhsum[n,0,xm,fc],
((lhsum[n,0,xm,fc]+rhsum[10,0,xm,fc])/2),
midsum[n,0,xm,fc],
simpsum[n,0,xm,fc]
};
vals=(3(#-((Sqrt[3])/2))&)/@vals;
errs=vals-π;
Thread[labels->Transpose[{vals,errs}]]
]//Column//N

Stirling’s approximation

lfs1=Table[Log[n!],{n,20}]

ListPlot[lfs1
,Joined->True
,Mesh->All
]

Plot[x Log[x]-x,{x,1,20}
,PlotStyle->ColorData[97][2]
]

Show[
ListPlot[lfs1
,Joined->True
,Mesh->All
],
Plot[x Log[x]-x+1,{x,1,20}
,PlotStyle->ColorData[97][2]
]
]

stirling[
x_
]:=
x Log[x]-x+(1/2)Log[2π x]

stirling[n]//FunctionExpand

Show[
ListPlot[lfs1
,Joined->True
,Mesh->All
],
Plot[stirling[x],{x,1,20}
,PlotStyle->Directive[ColorData[97][2],Thick]
]
]

gosper[
x_
]:=
x Log[x]-x+(1/2)Log[(2x+(1/3))π]

Show[
ListPlot[lfs1
,Joined->True
,Mesh->All
],
Plot[gosper[x],{x,1,20}
,PlotStyle->Directive[ColorData[97][2],Thick]
]
]

gosper[n]

Series[Log[n!],{n,∞,5}]

Show[
ListPlot[lfs1
,Joined->True
,Mesh->All
],
Plot[Log[x!],{x,1,20}
,PlotStyle->Directive[ColorData[97][2],Thick]
]
]

Plot[{
Log[Floor[x]],
Log[x-(1/2)]
},{x,1,20}
,Filling->{1->{2}}
]

Plot[{
Log[Ceiling[x]],
},{x,1,20}
,Filling->{1->{2}}
,PlotRange->{{1,All},{0,All}}
,Frame->{{True,False},{True,False}}
,PlotLegends->style/@{"(\[DifferentialD]/(\[DifferentialD]N))ln(N!)"}
]

Plot[{
Log[Ceiling[x]],
Log[x]
},{x,1,20}
,Filling->{1->{2}}
,PlotRange->{{1,All},{0,All}}
,Frame->{{True,False},{True,False}}
,PlotLegends->style/@{"(\[DifferentialD]/(\[DifferentialD]N))ln(N!)","ln(N)"}
]

Plot[{
Log[Ceiling[x]],
Log[x+(1/2)]
},{x,1,20}
,Filling->{1->{2}}
,PlotRange->{{1,All},{0,All}}
,Frame->{{True,False},{True,False}}
,PlotLegends->style/@{"(\[DifferentialD]/(\[DifferentialD]N))ln(N!)","ln(N+(1/2))"}
]

Plot[{
Log[Floor[x]],
Log[x-(1/2)]
},{x,1,5}
,Filling->{1->{2}}
]

Plot[{
Log[Floor[x]+1],
Log[x+(1/2)]
},{x,100,105}
,Filling->{1->{2}}
]

∫Log[x+(1/2)]\[DifferentialD]x

ad1=(x+(1/2)) Log[x+(1/2)]-x

D[ad1,x]//Simplify

Solve[0==ad1+C[1]/.x->1,C[1]]//Simplify

Assuming[
{x>1},
Integrate[Log[xx+(1/2)],{xx,1,x}]//Simplify
]

mylogfac[
x_
]:=Evaluate[
ad1+1-(3/2)Log[(3/2)]
];
{
mylogfac[x],
mylogfac[1]
}//Simplify

Show[
ListPlot[lfs1
,Joined->True
,PlotLegends->style/@{"ln(N!)"}
,Mesh->All
,PlotRange->{{1,All},{0,All}}
],
Plot[mylogfac[x],{x,1,20}
,PlotStyle->Directive[ColorData[97][2],Thick]
,PlotLegends->style/@{"approximation"}
]
]

Ah, that’s VERY good!

Plot[mylogfac[x]-Log[x!],{x,1,20}
,PlotRange->{All,0}
]

Plot[mylogfac[x]-Log[x!],{x,1,(10^6)}
,PlotRange->{All,0}
]

mylogfac[(10^6)]-Log[((10^6))!]//N

Series[Log[n!],{n,∞,1}]

Series[mylogfac[n],{n,∞,1}]

Series[mylogfac[n]-Log[n!],{n,∞,2}]//Normal//FullSimplify