Manipulate[SeedRandom[seed];
Block[{points,delaunay,bn},points=RandomReal[{0,1},{n,2}];
delaunay=delaunayComplex[points];
Graphics[{FaceForm[RGBColor[{215/255,224/255,229/255}]],GraphicsComplex[points,Polygon/@alphaComplexFaces[α,delaunay,points]],RGBColor[{12/255,90/255,129/255}],GraphicsComplex[points,Line/@alphaComplexEdges[α,delaunay,points]],RGBColor[{214/255,74/255,39/255}],PointSize[.015],Point[points],Black,If[homology,bn=bettiNumbers[α,delaunay,points];
{Inset[Style[Column[TraditionalForm/@Table[StringReplace["\!\(\*SubscriptBox[\(H\), \(dim\)]\) ≅ ","dim"->ToString[k-1]]<>Which[bn[[k]]==0,"{0}",bn[[k]]≤5,StringJoin[Riffle[Array["ℤ"&,bn[[k]]]," ⊕ "]],True,StringReplace["\!\(\*SuperscriptBox[\(ℤ\), \(dim\)]\)","dim"->ToString[bn[[k]]]]],{k,1,Length[bn]}],Alignment->{Left}],14],{-.1,1.1},{Left,Top}],Inset[Style[Column[TraditionalForm/@Table[StringReplace["\!\(\*SubscriptBox[\(β\), \(dim\)]\) = ","dim"->ToString[k-1]]<>ToString[bn[[k]]],{k,1,Length[bn]}],Alignment->{Right}],14],{1.1,1.1},{Right,Top}]},{}]},PlotRange->{{-.1,1.1},{0,1.1}},ImageSize->420]],{{α,0.418,"distance parameter (α)"},0,1,Appearance->"Labeled"},{{n,18,"number of points"},4,50,1,Appearance->"Labeled"},{{seed,32,"random seed"},1,100,1,Appearance->"Labeled"},{{homology,True,"compute homology"},{True,False}},SaveDefinitions->True,Initialization:>(Get["ComputationalGeometry`"];
delaunayComplex[points_]:=(Union[Flatten[Table[Join[Table[{edges[[1]],edges[[2,i]],edges[[2,i+1]]},{i,1,Length[edges[[2]]]-1}]],{edges,ComputationalGeometry`DelaunayTriangulation[points]}],1],SameTest->(Sort[#1]==Sort[#2]&)]);
alphaShapeQ[face_,α_,points_]:=Apply[And,#<α&/@(EuclideanDistance@@@Subsets[points[[face]],{2}])];
alphaComplexFaces[α_,delaunay_,points_]:=Select[delaunay,alphaShapeQ[#,α,points]&];
alphaComplexEdges[α_,delaunay_,points_]:=Select[Flatten[Sort[Subsets[#,{2}]]&/@delaunay,1],alphaShapeQ[#,α,points]&];
simplexBoundary[simplex_]:=Module[{len},len=Length[simplex];
Table[simplex[[Complement[Range[len],{i}]]],{i,1,len}]];
bettiNumbers[α_,delaunay_,points_]:=Module[{vertices,edges,faces,fullComplex,dim,groupProps},vertices={#}&/@Range[Length[points]];
edges=Sort/@alphaComplexEdges[α,delaunay,points];
faces=Sort/@alphaComplexFaces[α,delaunay,points];
fullComplex=Union[vertices,edges,faces];
dim=Max[Length/@fullComplex]-1;
groupProps=Join[{{Length@Select[fullComplex,Length[#]==1&],0}},Table[Module[{low,high,rows,columns},low=Select[fullComplex,Length[#]==k-1&];
high=Select[fullComplex,Length[#]==k&];
rows=Length[low];
columns=Length[high];
{columns,MatrixRank[Table[Module[{pos},pos=Flatten[Position[simplexBoundary[high[[c]]],low[[r]]]];
Which[pos=={},0,OddQ[First[pos]],-1,True,1]],{r,1,rows},{c,1,columns}]]}],{k,2,dim+1}]];
Table[If[k<dim+1,groupProps[[k,1]]-groupProps[[k,2]]-groupProps[[k+1,2]],groupProps[[k,1]]-groupProps[[k,2]]],{k,1,Length[groupProps]}]];)]