Message Boards

GROUPS:

Macy Maurer Levin

[WSC20] Visualisations of a Multiway Graph

Macy Maurer Levin, Stanford OHS

Posted 3 months ago

998 Views

2 Replies

4 Total Likes

Follow this post

A hypergraph is a graph in which edges, known as hyperedges, can join to multiple vertices, as denoted by the notation H = (V,ϵ), where V are the vertices made up of elements, ϵ.. In the Wolfram Model, hypergraphs depict space, and it is through these fascinating objects that it is hoped a proper model of the universe can be found. The objective of my project was to visualise one of these hypergraphs in such a way that the final result would resemble a Mollweide projection similar to that of the cosmic microwave background (CMB).

The Initial Visualisations

The first step of developing the visualisation was to choose a hypergraph from the Registry of Notable Universes off of the Wolfram Physics Project website. The hypergraph chosen for this project was W.M.1158, as pictured here.

hyper1158=Graph3D[ResourceFunction["HypergraphToGraph"]@ResourceFunction["WolframModel"][{{1,1,2},{3,2,4}}{{2,2,4},{5,2,3},{3,5,1}},{{0,0,0},{0,0,0}},12000,"FinalState"],VertexCoordinatesAutomatic];

In[]:=

Next, GraphEmbedding was used to attain the coordinates of the hypergraph.

GraphEmbedding@

;

In order to find the center of mass of the hypergraph, the median of the coordinates was found, as well as its position and the nearest point to the center of mass , and plotted into a 3D graph.

hypercords=GraphEmbedding[hyper1158];

In[]:=

Nearest[hypercords,SpatialMedian@hypercords];

In[]:=

Position[hypercords,#]&/@(Median@hypercords);

In[]:=

SpatialMedian[hypercords];

In[]:=

Graphics3D[{Sphere[hypercords,.2],Red,Sphere[SpatialMedian@hypercords,.3]}]

In[]:=

Out[]=

Graphics3D[{Sphere[hypercords,.2],Red,Sphere[SpatialMedian@hypercords,.3],Blue,Sphere[Nearest[hypercords,SpatialMedian@hypercords],.3]}]

In[]:=

Out[]=

Then, taking the points collected from GraphEmbedding as well as the center of mass, a simple 3D graphic was constructed, allowing one to meddle with the x, y, and z axis of the graph and see what the hypergraph would look like from various positions around it.

Manipulate[Graphics3D[Sphere[hypercords,.1],ViewVector{x,y,z},SphericalRegionTrue],{{x,3.863914082140808`},-1.1360859178591922`,8.863914082140807`},{{y,2.735766862974746`},-2.264233137025254`,7.735766862974746`},{{z,3.1262067518724943`},-1.8737932481275057`,8.126206751872495`},SaveDefinitionsTrue]

In[]:=

Out[]=

Developing the Final Visualisations

In order to plot the points from the hypergraph onto a sphere (the first step before converting to a Mollweide projection), the coordinates of the center-most node was set to be the origin, and the coordinates were converted to spherical coordinates, and from there I was able to derive the θ and ϕ coordinates, and set the ρ coordinate to 10.

closestCenterNode=Nearest[hypercords,SpatialMedian@hypercords][[1]];

In[]:=

coordsCentered=#-closestCenterNode&/@hypercords;

In[]:=

Position[coordsCentered,{0.,0.,0.}];

In[]:=

coordsCenteredDrop=Delete[coordsCentered,First@Position[coordsCentered,{0.,0.,0.}]];

In[]:=

coordsCenteredSpherical=ToSphericalCoordinates/@coordsCenteredDrop;

In[]:=

coordsCenteredSphericalSameR=coordsCenteredSpherical/.{x_,y_,z_}{10,y,z};

In[]:=

newCoords=FromSphericalCoordinates/@coordsCenteredSphericalSameR;

In[]:=

From there, the now spherically - projected coordinates were returned to Cartesian coordinates in order to plug them back into the function Graphics3D.

Graphics3D[Sphere[newCoords,.2]]

In[]:=

Out[]=

And, from this, the graph was able to be flatted and mapped to a Mollweide projection.

ListPlot[coordsCenteredSphericalSameR[[All,2;;]],PlotRangeAll]

In[]:=

Out[]=

thetaPhi=Rest/@coordsCenteredSphericalSameR;

In[]:=

Graphics[Point[thetaPhi],PlotRange{{0,π},{-π,π}}]

In[]:=

Out[]=



,GraphicsPoint(#1-π/2)

180

,#2

180

&@@@thetaPhi,PlotRange{{-90,90},{-180,180}}

In[]:=





Out[]=

latLong=(#1-π/2)

180

,#2

180

&@@@thetaPhi;

In[]:=

GeoGridPosition[GeoPosition[latLong[[1]]],"Mollweide"][[1]]

In[]:=

{-0.574113,1.23097}

Out[]=

maybePoints=First@GeoGridPosition[GeoPosition[#],"Mollweide"]&/@latLong;

In[]:=

MinMax/@{First/@maybePoints,Last/@maybePoints}

In[]:=

{{-2.82495,2.82721},{-0.995205,1.38558}}

Out[]=

Graphics[{PointSize[.005],Point@#},PlotRange(MinMax/@{First/@#,Last/@#})]&@maybePoints

In[]:=

Out[]=

Concluding Remarks

With the hypergraph mapped to a Mollweide projection, the next step would be to create a heat map of the points (which has already been toyed with, albeit not perfected), and create a fully visualised cosmic microwave background for this notable universe. With the functions created, this process can be repeated multiple times for various hypergraphs, in hopes that perhaps we will become closer to finding a model of our universe.