aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Task/Catmull-Clark-subdivision-surface/Mathematica/catmull-clark-subdivision-surface-1.math Normal file
View file

@ -0,0 +1,6 @@
subSetQ[large_,small_] := MemberQ[large,small]
subSetQ[large_,small_List] := And@@(MemberQ[large,#]&/@small)
containing[groupList_,item_]:= Flatten[Position[groupList,group_/;subSetQ[group,item]]]
ReplaceFace[face_]:=Transpose[Prepend[Transpose[{#[[1]],face,#[[2]]}&/@Transpose[Partition[face,2,1,1]//{#,RotateRight[#]}&]],face]]

28
Task/Catmull-Clark-subdivision-surface/Mathematica/catmull-clark-subdivision-surface-2.math Normal file
View file

@ -0,0 +1,28 @@
CatMullClark[{Points_,faces_}]:=Block[{avgFacePoints,avgEdgePoints,updatedPoints,newEdgePoints,newPoints,edges,newFaces,weights,pointUpdate,edgeUpdate,newIndex},
edges = DeleteDuplicates[Flatten[Partition[#,2,1,-1]&/@faces,1],Sort[#1]==Sort[#2]&];
avgFacePoints=Mean[Points[[#]]] &/@ faces;
avgEdgePoints=Mean[Points[[#]]] &/@ edges;
weights[vertex_]:= Count[faces,vertex,2]//{(#-3),1,2}/#&;
pointUpdate[vertex_]:=
If[Length[faces~containing~vertex]!=Length[edges~containing~vertex],
Mean[avgEdgePoints[[Select[edges~containing~vertex,holeQ[edges[[#]],faces]&]]]],
Total[weights[vertex]{ Points[[vertex]], Mean[avgFacePoints[[faces~containing~vertex]]], Mean[avgEdgePoints[[edges~containing~vertex]]]}]
];
edgeUpdate[edge_]:=
If[Length[faces~containing~edge]==1,
Mean[Points[[edge]]],
Mean[Points[[Flatten[{edge, faces[[faces~containing~edge]]}]]]]
];
updatedPoints = pointUpdate/@Range[1,Length[Points]];
newEdgePoints = edgeUpdate/@edges;
newPoints = Join[updatedPoints,avgFacePoints,newEdgePoints];
newIndex[edge_/;Length[edge]==2] := Length[Points]+Length[faces]+Position[Sort/@edges,Sort@edge][[1,1]]
newIndex[face_] := Length[Points]+Position[faces,face][[1,1]]
newFaces = Flatten[Map[newIndex[#,{Points,edges,faces}]&,ReplaceFace/@faces,{-2}],1];
{newPoints,newFaces}
]

5
Task/Catmull-Clark-subdivision-surface/Mathematica/catmull-clark-subdivision-surface-3.math Normal file
View file

@ -0,0 +1,5 @@
{points,faces}=PolyhedronData["Cube",{"VertexCoordinates","FaceIndices"}];
Function[iteration,
Graphics3D[(Polygon[iteration[[1]][[#]]]&/@iteration[[2]])]
]/@NestList[CatMullClark,{points,faces},3]//GraphicsRow

4
Task/Catmull-Clark-subdivision-surface/Mathematica/catmull-clark-subdivision-surface-4.math Normal file
View file

@ -0,0 +1,4 @@
faces = Delete[faces, 6];
Function[iteration, Graphics3D[
(Polygon[iteration[[1]][[#]]] & /@ iteration[[2]])
]] /@ NestList[CatMullClark, {points, faces}, 3] // GraphicsRow