Photorealistic Renderings of Wolfram Universe Models
Choose the model you want
Choose the model you want
There are a lot of interesting Wolfram Universe models out there! You can see a list of neat ones at the Wolfram Physics Project website’s “Registry of Notable Universe Models” here: https://www.wolframphysics.org/universes/.
Once you find an interesting model, you can import them into a notebook by using the WolframModel ResourceFunction, and then display the model using Graph3D:
Once you find an interesting model, you can import them into a notebook by using the WolframModel ResourceFunction, and then display the model using Graph3D:
model3d15=Graph3D[ResourceFunction["WolframModel"][{{{1,1,2},{3,2,4}}{{5,5,2},{5,3,4},{3,2,1}}},{{1,1,1},{1,1,1}},1600,"FinalState"]]//Quiet
Out[]=
model3d16=Graph3D[ResourceFunction["WolframModel"][{{1,2,1},{1,3,4}}{{4,5,4},{5,4,3},{1,2,5}},{{0,0,0},{0,0,0}},500,"FinalState"]]//Quiet
Out[]=
Make the lines into tubes, with specified thickness
Make the lines into tubes, with specified thickness
To turn the above Graph3D objects into 3D-printable STL files, we’ll turn the graph connections into tubes with a user-provided thickness. The code is actually a good exercise in using Apply, Map and general list manipulation, and I recommend it as an exercise.
Here, the model from above is turned into a conglomeration of tubes with thickness 0.02:
Here, the model from above is turned into a conglomeration of tubes with thickness 0.02:
v2=GetGraphData2[model3d15,0.02]//Graphics3D
Out[]=
And here it is with a much thicker tube size, obfuscating some of the fine detail:
v3=GetGraphData2[model3d15,0.1]//Graphics3D
Out[]=
In[]:=
GetGraphData[graph_,thickness_]:=Map[Apply[Tube,#]&,Map[Append[#,thickness]&,Module[{coors=NumbererAssociation[(Show[graph]/.{Graphics3DList,GraphicsComplexList})[[1,1]]]},MapAll[If[Head[#]===Integer,coors[#],#]&,Select[Map[First,(Select[(Show[graph]/.{Graphics3DList,GraphicsComplexList})[[1,2,1]],Head[#]===Arrow&])/.{ArrowList}],Head[#]===Tube&]]]/.{TubeList}]]NumbererAssociation[x_]:=Map[#[[1]]#[[2]]&,Transpose[{Range[Length[x]],x}]]//AssociationGetGraphData2[graph_,thickness_]:=Module[{coors=NumbererAssociation[Flatten[Apply[List,Show[graph][[1,2,2]]],1]]},Map[Apply[Tube,{#[[1,1;;2]],#[[2]]}]&,Map[Append[#,thickness]&,Map[First,Show[graph][[1,1,2;;-1]]]/.{LineList}]]]
Exporting, simplification and repair
Exporting, simplification and repair
That’s all there is to it - you can now export the tube-version into an STL or OBJ file:
Export["/Users/rmendelsohn/Desktop/WPP/graph3.obj",GetGraphData2[model3d15,0.1]//Graphics3D,"OBJ"]
Out[]=
/Users/rmendelsohn/Desktop/WPP/graph3.obj
Sometimes you will get error when you upload them to rendering programs (I use Keyshot) or places for 3D printing (like 3D Hubs). This can be fixed by importing the model into a program (I like Meshlab (free, OSX)) and exporting it. In such a program you can also simplify, ‘repair’ and smooth the shape, if desired.