Here is the code displayed in Homework 10.
See This blog entry
It is based on the following work: from
August 2015, from
December 2023 and January 2024.
If we look at a function on a m-manifold taking values in a finite set {0,...,k} .
the level set is either empty or a m-k manifold. Always!
The code should be pretty self-explanatory. Lines 1,2,3,5 are the core of the program and allow to generate
any level manifold in an arbitrary manifold. The line R[G,k] picks a random function with values in {0,...,k} on the vertex set.
Line 4 computes the Euler characteristic as well as the f-vector (like f=(V,E,F) in the two dimensional case).
Barycentric gives the Barycentric refinement of a graph. Like the second Barycentric refinement of the Icosahedron:
generated with GraphPlot3D[Nest[Barycentric,PolyhedronData["Icosahedron", "Skeleton"],2]].
We leave the code in ASCII form as Mathematica notebooks change over the years
(I use it since 28 years and am happy to have always kept all code and data also in simple ASCII form, what is stored today in proprietary
form defined by some industry almost certainly does not work any more in 10 years). Interfaces change, but language is eternal
or can be adapted over time. Even in 100 years, the code is working pseudo code. It should be possible to translate it easily
into any other language (even automatically). Also, notebooks ruin the "poem", by introducing spaces or line breaks for readability.
It should be no problem to dissect it. For example, to understand a specific line, start from the core. For example:
what does Generate do? Start with A={{1,2,3}}; B=Map[Subsets,A] .
This produces a list of all subsets of A. Flatten[B,1] then writes this as a list of lists. You guess what Sort does.
UnionDelete[X,1] then deletes the first entry in X, which is the empty set {}.
The empty set {} is a simplicial complex (as it satisfies all the axioms) but the empty set is
never part of a simplicial complex. (There are dialects in combinatorial topology which includes the empty set. This can make sense in
frame works like matroid theory but it completely destroys the elegance of the framework however, especially when dealing with
finite dimensional manifolds and also culturally clashes with many conventions both historically and intuitively.
(* Generating discrete manifolds Oliver Knill, 2024 *)
Generate[A_]:=If[A=={},{},Sort[Delete[Union[Sort[Flatten[Map[Subsets,A],1]]],1]]];
Whitney[s_]:=Generate[FindClique[s,Infinity,All]]; w[x_]:=-(-1)^k;
R[G_,k_]:=Module[{},R[x_]:=x->RandomChoice[Range[k]]; Map[R,Union[Flatten[G]]]];
F[G_]:=Delete[BinCounts[Map[Length,G]],1]; Euler[G_]:=F[G].Table[w[k],{k,Length[F[G]]}];
Surface[G_,g_]:=Select[G,SubsetQ[#/.g,Union[Flatten[G] /. g]] &];
S[s_,v_]:=VertexDelete[NeighborhoodGraph[s,v],v]; Sf[s_,v_]:=F[Whitney[S[s,v]]];
Curvature[s_,v_]:=Module[{f=Sf[s,v]},1+f.Table[(-1)^k/(k+1),{k,Length[f]}]];
Curvatures[s_]:=Module[{V=VertexList[s]},Table[Curvature[s,V[[k]]],{k,Length[V]}]];
J[G_,H_]:=Union[G,H+Max[G]+1,Map[Flatten,Map[Union,Flatten[Tuples[{G,H+Max[G]+1}],0]]]];
ToGraph[G_]:=UndirectedGraph[n=Length[G];Graph[Range[n],
Select[Flatten[Table[k->l,{k,n},{l,k+1,n}],1],(SubsetQ[G[[#[[2]]]],G[[#[[1]]]]])&]]];
Barycentric[s_]:=ToGraph[Whitney[s]];
G=J[Whitney[Barycentric[CompleteGraph[{2,2,2}]]],Whitney[CycleGraph[7]]]; (* J=Join *)
g=R[G,3]; H=Surface[G,g]; (* A codimension 2 manifold in the 4-sphere G=Oct * C_7 *)
Print["EulerChi= ",Euler[H]]; Print["Fvector: ",F[H]];s=ToGraph[H];GraphPlot3D[s]
Print["Gauss-Bonnet Check: "]; Print[Total[Curvatures[s]]==Euler[H]];
Print["Curvature Values: "]; Print[Union[Curvatures[s]]];
|
