Related
First, I learned from
In Mathematica, what interpolation function is ListPlot using?
that the the method used by ListPlot for interpolation is to interpolate each coordinate as a function of the list index. And I think the ListLinePlot can decide which InterpolationOrder should be taken.
If I change the InterpolationOrder -> 3 into InterpolationOrder -> 1 , the intepolation of my data is more like the plot of ListLinePlot.
Here is the data and code:
So, is there any way I can interpolate my data and plot it as good as ListLinePlot do? Or is there any way to make my interpolation more "clever", so it can also decide the InterpolationOrder itself?
Here is the data and code:
mypoint = {{1.3336020610508064`,
0.05630827677109675`}, {1.5103543939292194`,
0.05790550283922009`}, {1.6927497417380886`,
0.07151008153610137`}, {1.840047310044461`,
0.11741226450605104`}, {1.9209270855795286`,
0.2726755425789721`}, {1.953407919235778`,
2.0759615023390294`}, {1.9550995254889463`, 0.7164793699550908`}};
interpcut[r_, x_] := Module[{s}, s = SortBy[r, First];
Piecewise[{{0, x < First[s][[1]]}, {0,
x > Last[s][[1]]}, {Interpolation[r, InterpolationOrder -> 3][x],
True}}]];
Interpolation1[x_] := interpcut[mypoint, x];
ListPlot[mypoint, PlotStyle -> Orange]
ListLinePlot[mypoint, PlotStyle -> Orange]
Plot[Interpolation1[x], {x, 1.3, 2}, PlotRange -> All,
PlotStyle -> Orange]
thanks,
Jzm
For the question of #agentp:
mypoint1 = {{1.3336020610508064`,
0.05630827677109675`}, {1.5103543939292194`,
0.05790550283922009`}, {1.6927497417380886`,
0.07151008153610137`}, {1.840047310044461`,
0.11741226450605104`}, {1.9209270855795286`,
0.2726755425789721`}, {1.953407919235778`,
2.0759615023390294`}, {1.9550995254889463`, 0.7164793699550908`}};
interpcut[r_, x_] := Module[{s},(*sort array by x coord*)s = SortBy[r, First];
Piecewise[{{0, x < First[s][[1]] + 0.002}, {0,
x > Last[s][[1]] - 0.002}, {Interpolation[r][x], True}}]];
Group1point = ListPlot[mypoint1, PlotStyle -> Red];
Group1Interpolation[x_] := interpcut[mypoint1, x];
Group1line = Plot[Group1Interpolation[x], {x, 1.3, 2}, PlotRange -> All, PlotStyle -> Red];
Show[{Group1point, Group1line}, Frame -> True, ImageSize -> 500]
I am having trouble plotting multiple functions on separate graph by using the Do loop. I have already figured out how to do it for just one fit function, but now I have to do it for 9 more fit functions.
m = 10;
t0IGList = {0.01, 0.01, 0.012, 0.015, 0.018, 0.022, 0.028, 0.035,
0.042, 0.05};
SubDataFit =
NonlinearModelFit[SubDataList[[1]],
A/(1 + (2 (t - t0)/\[Sigma])^2) +
B0, {{A, 0.7}, {t0, t0IGList[[1]]}, {\[Sigma], 0.006}, {B0, 7.0}},
t];
SubFitPlot =
Plot[SubDataFit[t], {t, 0, 0.07}, ImageSize -> 500,
FrameLabel -> {"Time (s)", "Voltage (V)"}, PlotStyle -> Red,
PlotRange -> {7, 7.8}];
Do[{
SubDataFit[[i]] =
NonlinearModelFit[SubDataList[[i]],
A/(1 + (2 (t - t0)/\[Sigma])^2) +
B0, {{A, 0.7}, {t0, t0IGList[[i]]}, {\[Sigma], 0.006}, {B0,
7.0}}, t];
SubFitPlot =
Plot[SubDataFit[t], {t, 0, 0.07}, ImageSize -> 500,
FrameLabel -> {"Time (s)", "Voltage (V)"}, PlotStyle -> Red];
Print["B = ", i, "Volts"];
Print[SubDataPlot];}, {i, 1, m}];
You say you want to plot "multiple functions on separate graph", which seems to mean you want 10 separate graphs. If that right. If so, you can separate out the two pieces of what you want: producing the fits in a loop and collecting them into a list, and then plotting the fitted functions. You can make your plotting function as complicated as you wish. Simple example:
flst = {x, x^2, x^3, Log[x]}
Plot[#, {x, 0.01, 2}] & /# flst
Once you have this list of plots you can do anything your want with them (e.g., make a GraphicsGrid, or Export them, etc.)
Try using Module. Create a function
plot[i_]:=Module[{local variables for module},
Any actions you want: fits, calculations etc. Separate them with ";";
Plot[i-th function]].
Then you could use this function with different i from you range to create plots you want.
When I draw multiple functions like exp,2^x,3^x, is it possible to generate a label of each function?
My code now:
Plot[{Exp[x], 2^x, 3^x}, {x, -5, 2}, AspectRatio -> Automatic, PlotStyle -> {Red, Green, Blue}]
What I mean is generate 3 labels in this case to tell the user what function it is.
Such as:
How do you generate this?
Perhaps this works: Use Tooltip in Plot to generate a Graphics object with tooltips. Then rewrite the tooltip to place the desired text in the desired location:
Plot[
Tooltip#{Exp[x], 2^x, 3^x}, {x, -5, 2},
AspectRatio -> Automatic,
PlotStyle -> {Red, Green, Blue},
PlotRange -> All,
PlotRangePadding -> 1.1] /.
{
Tooltip[{_, color_, line_}, tip_]
:>
{Text[Style[tip, 14], {.25, 0} + line[[1, -1]]], color, line}
}
I am not sure what the rules are for adding another, different answer for the same question. But here is another, different way to do it. If I am supposed to add this to my first answer, I can do that.
You can add the text labels, by hand, using Text commands. I think it looks better. Here is one way:
Clear[x];
funs = {Exp[x], 2^x, 3^x};
funNames = Style[#, 12] & /# funs;
(*the x-axis plot range used *)
from = -5; to = 2;
(* generate the coordinates at the end of the plot lines*)
pos = Map[{to, #} &, funs /. x -> to];
(*generate the text labels *)
text = Map[Text[#[[1]], #[[2]], {-1, 0}] &, Thread[{funNames, pos}]];
Plot the final result (added a little of padding to plot range so that
the labels added are seen completely)
Plot[funs, {x, from, to},
PlotRangePadding -> {1, 1},
PlotStyle -> {Red, Green, Blue},
PlotRange -> All,
Epilog -> text
]
update (1)
Sam asked below for an simpler way. I am not sure now. But one way to make it easier to use this method, is to make a function and then simply call this function once to generate the Text labels. You can put this function where you put all your other functions you use all the time, and just call it.
Here is something: First write the function
(*version 1.1*)
myLegend[funs_List, (*list of functions to plot*)
x_, (*the independent variable*)
from_?(NumericQ[#] && Im[#] == 0 &),(*the x-axis starting plot range*)
to_?(NumericQ[#] && Im[#] == 0 &) (*the x-axis ending plot range*)
] := Module[{funNames, pos, text, labelOffset = -1.3},
(*make label names*)
funNames = Style[#, 12] & /# funs;
(*generated the coordinates at the end of the plot lines*)
pos = Map[{to, #} &, funs /. x -> to];
(*generate the Text calls*)
text = Map[Text[#[[1]], #[[2]], {labelOffset, 0}] &,
Thread[{funNames, pos}]]
];
And now just call the above any time you want to plot with labels. It will be just 1-2 extra lines of code. like this:
Clear[x]
from = -5; to = 2;
funs = {Exp[x], 2^x, 3^x};
Plot[funs, {x, from, to}, PlotRangePadding -> {1, 1},
PlotStyle -> {Red, Green, Blue}, PlotRange -> All,
Epilog -> myLegend[funs, x, from, to]]
Here are few examples:
You can modify it as you want.
Alternative way with Tooltip displaying labels while the mouse pointer is at the function graphs :
Plot[Tooltip#{Exp[x], 2^x, 3^x}, {x, -5, 2}, AspectRatio -> Automatic,
PlotStyle -> {Red, Green, Blue}]
One way is to use PlotLegends
(I do not like it too much, but it is an easy way to do what you want)
<< PlotLegends`
Clear[x];
funs = {Exp[x], 2^x, 3^x};
legends = Map[Text#Style[#, "TR", 12] &, funs];
Plot[Evaluate#funs, {x, -5, 2}, AspectRatio -> Automatic,
PlotStyle -> {Red, Green, Blue}, PlotLegend -> legends]
see help to customize the legend more. The above uses defaults.
http://reference.wolfram.com/mathematica/PlotLegends/tutorial/PlotLegends.html
Here is a set of structured 3D points. Now we can form a BSpline using these points as knots.
dat=Import["3DFoil.mat", "Data"]
fu=BSplineFunction[dat]
Here we can do a ParametricPlot3D with these points.
pic=ParametricPlot3D[fu[u,v],{u, 0, 1}, {v, 0, 1}, Mesh -> All, AspectRatio ->
Automatic,PlotPoints->10,Boxed-> False,Axes-> False]
Question
If we carefully look at the 3D geometry coming out of the spline we can see that it is a hollow structure. This hole appears in both side of the symmetric profile. How can we perfectly (not visually!) fill up this hole and create a unified Graphics3D object where holes in both sides are patched.
What I am able to get so far is the following. Holes are not fully patched.
I am asking too many questions recently and I am sorry for that. But if any of you get interested I hope you will help.
Update
Here is the problem with belisarius method.
It generates triangles with almost negligible areas.
dat = Import[NotebookDirectory[] <> "/3DFoil.mat", "Data"];
(*With your points in "dat"*)
fd = First#Dimensions#dat;
check = ParametricPlot3D[{BSplineFunction[dat][u, v],
BSplineFunction[{dat[[1]], Reverse#dat[[1]]}][u, v],
BSplineFunction[{dat[[fd]], Reverse#dat[[fd]]}][u, v]}, {u, 0,
1}, {v, 0, 1}, Mesh -> All, AspectRatio -> Automatic,
PlotPoints -> 10, Boxed -> False, Axes -> False]
output is here
Export[NotebookDirectory[]<>"myres.obj",check];
cd=Import[NotebookDirectory[]<>"myres.obj"];
middle=
check[[1]][[2]][[1]][[1(* Here are the numbers of different Graphics group*)]][[2,1,1,1]];
sidePatch1=check[[1]][[2]][[1]][[2]][[2,1,1,1]];
sidePatch2=check[[1]][[2]][[1]][[3]][[2,1,1,1]];
There are three Graphics groups rest are empty. Now lets see the area of the triangles in those groups.
polygonArea[pts_List?
(Length[#]==3&)]:=Norm[Cross[pts[[2]]-pts[[1]],pts[[3]]-pts[[1]]]]/2
TriangleMaker[{a_,b_,c_}]:={vertices[[a]],vertices[[b]],vertices[[c]]}
tring=Map[polygonArea[TriangleMaker[#]]&,middle];
tring//Min
For the middle large group output is
0.000228007
This is therefore a permissible triangulation. But for the side patches we get zero areas.
Map[polygonArea[TriangleMaker[#]] &, sidePatch1] // Min
Map[polygonArea[TriangleMaker[#]] &, sidePatch2] // Min
Any way out here belisarius ?
My partial solution
First download the package for simplifying complex polygon from Wolfram archive.
fu = BSplineFunction[dat];
pic =(*ParametricPlot3D[fu[u,v],{u,0,1},{v,0,1},Mesh->None,
AspectRatio->Automatic,PlotPoints->25,Boxed->False,Axes->False,
BoundaryStyle->Red]*)
ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> None,
AspectRatio -> Automatic, PlotPoints -> 10, Boxed -> False,
Axes -> False, BoundaryStyle -> Black];
bound = First#Cases[Normal[pic], Line[pts_] :> pts, Infinity];
corners = Flatten[Table[fu[u, v], {u, 0, 1}, {v, 0, 1}], 1];
nf = Nearest[bound -> Automatic]; {a1, a2} =
Union#Flatten#(nf /# corners);
sets = {bound[[2 ;; a1]], bound[[a1 ;; a2]],bound[[a2 ;; a2 + a1]]};
CorrectOneNodeNumber = Polygon[sets[[{1, 3}]]][[1]][[1]] // Length;
CorrectOneNodes1 =
Polygon[sets[[{1, 3}]]][[1]][[1]]; CorrectOneNodes2 =
Take[Polygon[sets[[{1, 3}]]][[1]][[2]], CorrectOneNodeNumber];
<< PolygonTriangulation`SimplePolygonTriangulation`
ver1 = CorrectOneNodes1;
ver2 = CorrectOneNodes2;
triang1 = SimplePolygonTriangulation3D[ver1];
triang2 = SimplePolygonTriangulation3D[ver2];
Show[Graphics3D[{PointSize[Large], Point[CorrectOneNodes1]},Boxed -> False,
BoxRatios -> 1], Graphics3D[{PointSize[Large], Point[CorrectOneNodes2]},
Boxed -> False, BoxRatios -> 1],
Graphics3D[GraphicsComplex[ver1, Polygon[triang1]], Boxed -> False,
BoxRatios -> 1],
Graphics3D[GraphicsComplex[ver2, Polygon[triang2]], Boxed -> False,
BoxRatios -> 1]]
We get nice triangles here.
picfin=ParametricPlot3D[fu[u,v],{u,0,1}, {v,0,1},Mesh->All,AspectRatio->Automatic,PlotPoints->10,Boxed->False,Axes->False,BoundaryStyle->None];pic3D=Show[Graphics3D[GraphicsComplex[ver1,Polygon[triang1]]],picfin,Graphics3D[GraphicsComplex[ver2,Polygon[triang2]]],Boxed->False,Axes->False]
Now this has just one problem. Here irrespective of the PlotPoints there are four triangles always appearing that just shares only one edge with any other neighboring triangle. But we expect all of the triangles to share at least two edges with other trangles. That happens if we use belisarius method. But it creates too small triangles that my panel solver rejects as tingles with zero area.
One can check here the problem of my method. Here we will use the method from the solution by Sjoerd.
Export[NotebookDirectory[]<>"myres.obj",pic3D];
cd=Import[NotebookDirectory[]<>"myres.obj"];
polygons=(cd[[1]][[2]]/.GraphicsComplex-> List)[[2]][[1]][[1,1]];
pt=(cd[[1]][[2]]/.GraphicsComplex-> List)[[1]];
vertices=pt;
(*Split every triangle in 3 edges,with nodes in each edge sorted*)
triangleEdges=(Sort/#Subsets[#,{2}])&/#polygons;
(*Generate a list of edges*)
singleEdges=Union[Flatten[triangleEdges,1]];
(*Define a function which,given an edge (node number list),returns the bordering*)
(*triangle numbers.It's done by working through each of the triangles' edges*)
ClearAll[edgesNeighbors]
edgesNeighbors[_]={};
MapIndexed[(edgesNeighbors[#1[[1]]]=Flatten[{edgesNeighbors[#1[[1]]],#2[[1]]}];
edgesNeighbors[#1[[2]]]=Flatten[{edgesNeighbors[#1[[2]]],#2[[1]]}];
edgesNeighbors[#1[[3]]]=Flatten[{edgesNeighbors[#1[[3]]],#2[[1]]}];)&,triangleEdges];
(*Build a triangle relation table.Each'1' indicates a triangle relation*)
relations=ConstantArray[0,{triangleEdges//Length,triangleEdges//Length}];
Scan[(n=edgesNeighbors[##];
If[Length[n]==2,{n1,n2}=n;
relations[[n1,n2]]=1;relations[[n2,n1]]=1];)&,singleEdges]
(*Build a neighborhood list*)
triangleNeigbours=Table[Flatten[Position[relations[[i]],1]],{i,triangleEdges//Length}];
trires=Table[Flatten[{polygons[[i]],triangleNeigbours[[i]]}],{i,1,Length#polygons}];
Cases[Cases[trires,x_:>Length[x]],4]
Output shows always there are four triangles that shares only one edges with others.
{4,4,4,4}
In case of belisarius method we don't see this happening but there we get triangles with numerically zero areas.
BR
Import the data and construct the BSpline function as before:
dat = Import["Downloads/3DFoil.mat", "Data"];
fu = BSplineFunction[dat]
Generate the surface, making sure to include (only) the boundary line, which will follow the edge of the surface. Make sure to set Mesh to either All or None.
pic = ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> None,
AspectRatio -> Automatic, PlotPoints -> 10, Boxed -> False,
Axes -> False, BoundaryStyle -> Red]
Extract the points from the boundary line:
bound = First#Cases[Normal[pic], Line[pts_] :> pts, Infinity]
Find the "corners", based on your parameter space:
corners = Flatten[Table[fu[u, v], {u, 0, 1}, {v, 0, 1}], 1]
Find the edge points best corresponding to the corners, keeping in mind that ParametricPlot3D doesn't use the limits exactly, so we can't just use Position:
nf = Nearest[bound -> Automatic];
nf /# corners
Figure our which range of points on the boundary correspond to the areas you need to fill up. This step involved some manual inspection.
sets = {bound[[2 ;; 22]], bound[[22 ;; 52]], bound[[52 ;; 72]],
bound[[72 ;;]]}
Construct new polygons corresponding to the holes:
Graphics3D[Polygon[sets[[{1, 3}]]], Boxed -> False, BoxRatios -> 1]
Show[pic, Graphics3D[Polygon[sets[[{1, 3}]]]]]
Note that there is probably still a hole that can't be seen where the edge runs between the holes you mentioned, and I haven't tried to fill it in, but you should have enough information to do that if needed.
Your data set looks like this:
Graphics3D[Point#Flatten[dat, 1]]
It consists of 22 sections of 50 points.
Adding a mid-line in each end section (which is actually the end section flattened):
dat2 = Append[Prepend[dat,
Table[(dat[[1, i]] + dat[[1, -i]])/2, {i, Length[dat[[1]]]}]
],
Table[(dat[[-1, i]] + dat[[-1, -i]])/2, {i, Length[dat[[-1]]]}]
];
Graphics3D[{Point#Flatten[dat, 1], Red, Point#dat2[[1]], Green, Point#dat2[[-1]]}]
Now add some weights to the wingtip rim:
sw = Table[1, {24}, {50}];
sw[[2]] = 1000 sw[[1]];
sw[[-2]] = 1000 sw[[1]];
fu = BSplineFunction[dat2, SplineWeights -> sw];
Show[
ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> All,
AspectRatio -> Automatic, PlotPoints -> 20, Boxed -> False,
Axes -> False, Lighting -> "Neutral"
],
Graphics3D[{PointSize -> 0.025, Green, Point#dat2[[-1]], Red,Point#dat2[[-2]]}]
]
Note that I increased the PlotPoints value to 20.
(*With your points in "dat"*)
fu = BSplineFunction[dat[[1 ;; 2]]];
Show[{ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1},
Mesh -> All, AspectRatio -> Automatic, PlotPoints -> 30],
ListPlot3D[dat[[1]]]}]
And with
InputForm[%]
you get the "unified" graphics object.
Edit
Another way, probably better:
(*With your points in "dat"*)
fu = BSplineFunction[dat];
Show[
{ ParametricPlot3D[fu[u, v], {u, 0, 1}, {v, 0, 1},
Mesh -> All, AspectRatio -> Automatic,
PlotPoints -> 10, Boxed -> False, Axes -> False],
ParametricPlot3D[
BSplineFunction[{First#dat, Reverse#First#dat}][u, v], {u, 0, 1}, {v, 0, 1},
Mesh -> None, PlotStyle -> Yellow],
ParametricPlot3D[
BSplineFunction[{dat[[First#Dimensions#dat]],
Reverse#dat[[First#Dimensions#dat]]}]
[u, v], {u, 0, 1}, {v, 0, 1}]}]
In just one structure:
(*With your points in "dat"*)
fd = First#Dimensions#dat;
ParametricPlot3D[
{BSplineFunction[dat][u, v],
BSplineFunction[{dat[[1]], Reverse#dat[[1]]}] [u, v],
BSplineFunction[{dat[[fd]], Reverse#dat[[fd]]}][u, v]},
{u, 0, 1}, {v, 0, 1},
Mesh -> All, AspectRatio -> Automatic,
PlotPoints -> 10, Boxed -> False, Axes -> False]
Edit
You can check that there are small triangles, but they are triangles indeed and not zero area polygons:
fu = BSplineFunction[dat];
check = ParametricPlot3D[{BSplineFunction[{First#dat, Reverse#dat[[1]]}][u, v]},
{u, 0, 1}, {v, 0, 1}, Mesh -> All,
PlotStyle -> Yellow, Mesh -> All, AspectRatio -> Automatic,
PlotPoints -> 10, Boxed -> False, Axes -> False];
pts = check /. Graphics3D[GraphicsComplex[a_, b__], ___] -> a;
m = check[[1]][[2]][[1]][[1]] /. {___, GraphicsGroup[{Polygon[a_]}]} -> a;
t = Replace[m, {a_, b_, c_} -> {pts[[a]], pts[[b]], pts[[c]]}, {1}];
polygonArea[pts_List?(Length[#] == 3 &)] :=
Norm[Cross[pts[[2]] - pts[[1]], pts[[3]] - pts[[1]]]]/2;
t[[Position[Ordering[polygonArea /# t], 1][[1]]]]
(*
->{{{-4.93236, 0.0989696, -2.91748},
{-4.92674, 0.0990546, -2.91748},
{-4.93456, 0.100181, -2.91748}}}
*)
Is it possible to automate the addition of any text to the faces of a polyhedron, like this manually-drawn graphic shows (the example's odd numbering scheme isn't relevant):
It was easy enough to label the vertices:
c = 1;
Show[{Graphics3D[
Text[c++, #] & /# PolyhedronData["Dodecahedron", "VertexCoordinates"]],
PolyhedronData["Dodecahedron"]},
Boxed -> False]
(even though some of the text is placed in front of the shape for vertices that are hidden. That's probably soluble.)
But when I tried to do the same thing for faces, nothing worked. PolyhedronData["Dodecahedron", "Faces"] returns a GraphicsComplex, rather than coordinates.
Am I overlooking an easy solution/option?
Edit: thanks for these answers, they're all brilliant. If I could combine the text placing of szabolcs' answer with the text quality of belisarius', the perfect solution is in sight!
Here's a funky approach:
(* this function just transforms the polygon onto the [0,1] 2D square *)
vtc[face_, up_:{0,0,1}] := Module[{pts, pts2, centre, r, r2, topmost},
pts = N#face;
centre = Mean[pts];
pts = (# - centre & /# pts);
r = SingularValueDecomposition[pts][[3]];
(* these two lines ensure that the text on the outer face
of a convex polyhedron is not mirrored *)
If[Det[r] < 0, r = -r];
If[Last[centre.r] < 0, r = r.RotationMatrix[\[Pi], {1, 0, 0}]];
pts2 = Most /# (pts.r);
topmost = Part[pts2, First#Ordering[up.# & /# pts, -1]];
r2 = Transpose[{{#2, -#1} & ## topmost, topmost}];
r2 /= Norm[r2];
Rescale[pts2.r2]
]
faces = First /# First#Normal#PolyhedronData["Dodecahedron", "Faces"];
numbers =
Graphics[Text[
Style[#, Underlined, FontFamily -> "Georgia",
FontSize -> Scaled[.3]]]] & /# Range#Length[faces];
Graphics3D[
MapThread[{Texture[#1],
Polygon[#2, VertexTextureCoordinates -> vtc[#2]]} &, {numbers,
faces}],
Boxed -> False
]
Demoing a "SmallRhombicosidodecahedron":
a = PolyhedronData["Dodecahedron", "Faces"] /. GraphicsComplex -> List;
c = 1;
Show[{Graphics3D[
Text[c++, #] & /# (Mean /# (a[[1, #]] & /# a[[2, 1]]))],
PolyhedronData["Dodecahedron"]}, Boxed -> False]
Edit
Perhaps better:
Show[{Graphics3D[
MapIndexed[Text[#2, #1] &,
Mean /# (PolyhedronData["Dodecahedron", "VertexCoordinates"][[#]] & /#
PolyhedronData["Dodecahedron", "FaceIndices"])]],
PolyhedronData["Dodecahedron"]}, Boxed -> False]
Edit
Or
text = Style[#, 128] & /# Range[12]
Graphics3D#
Riffle[Texture /# text,
(Append[#1, {VertexTextureCoordinates ->
With[{n = Length[First[#1]]}, Table[1/2 {Cos[2 Pi i/n], Sin[2 Pi i/n]}+
{1/2, 1/2}, {i, 0, n - 1}]]}] &) /#
Flatten[Normal[PolyhedronData["Dodecahedron", "Faces"]]]]