Clear[squareQ]
squareQ::noRegion = "No 2D region given.";
squareQ::edgesDiffer = "Edges differ: `1`";
squareQ::areaMismatch = "Area mismatch `1` vs. `2`";
squareQ::anglesDiffer = "Angles differ:`1`";
squareQ[pts_List] := Block[{preci = 9,
res = RegionQ[Polygon[pts]], rd = RegionDimension[Polygon[pts]],
pats = Partition[pts, 2, 1, 1], edges, vecs, angles},
If[res \[And] rd == 2,
edges = EuclideanDistance @@@ pats;
If[Length[DeleteDuplicates[N[edges, preci]]] == 1,
area = RegionMeasure[Polygon[pts], 2];
If[area == First[edges^2],
vecs = -(Subtract @@@ pats);
angles = VectorAngle @@@ Partition[vecs, 2, 2, 1];
If[Length[DeleteDuplicates[N[angles, preci]]] != 1,
Message[squareQ::anglesDiffer, N[angles, preci]];
res = False
] ,(* else *)
Message[squareQ::areaMismatch, area, First[edges^2]];
res = False
], (* else *)
Message[squareQ::edgesDiffer, N[edges, preci]];
res = False
], (* else *)
Message[squareQ::noRegion];
res = False
];
res
] /; MatrixQ[pts, NumericQ] \[And] Dimensions[pts] == {4, 2}
Clear[finslerHadwiger]
finslerHadwig::identity = "Only one square given.";
finslerHadwig::joinLost = "Lost the joint origin: `1` != `2`";
finslerHadwig::noSquare = "Did not create a square:\.08 `1`";
finslerHadwiger[w1_Integer, s1_Integer?Positive, w2_Integer,
s2_Integer?Positive] :=
Message[finslerHadwig::identity] /;
s1 == s2 \[And] Mod[w1, 360] == Mod[w2, 360]
finslerHadwiger[w1_Integer, s1_Integer?Positive, w2_Integer,
s2_Integer?Positive] := Block[{
q1 = RotationTransform[Degree w1][Polygon[Tuples[{0, s1}, 2], {1,
3, 4, 2}]],
q2 = RotationTransform[Degree w2][Polygon[Tuples[{0, s2}, 2], {1,
3, 4, 2}]],
p1, p2, p3, mp3},
p1 = Permute[q1[[1]], Cycles[{{3, 2, 4}}]];
p2 = Permute[q2[[1]], Cycles[{{3, 2, 4}}]];
p2 = RotateRight[Reverse[p2]];
If[p1[[1]] != p2[[1]],
Message[finslerHadwig::joinLost, p1[[1]], p2[[1]]];
Return[$Failed]
];
p3 = Transpose[{p1, Permute[p2, Cycles[{{3, 1}}]]}];
mp3 = Mean /@ p3;
If[squareQ[mp3],
Graphics[{{FaceForm[None], EdgeForm[{Thick, Cyan}], q1},
{FaceForm[None], EdgeForm[{Thick, Yellow}], q2},
{White, Thin, Line[p3]},
{FaceForm[None], EdgeForm[{Thick, Red}], Polygon[mp3]}
}], (* else *)
Message[finslerHadwig::noSquare, mp3];
Return[$Failed]
]
] /; (Mod[w1, 360] != Mod[w2, 360]) \[Or] (s1 != s2)
und man kann es zu der zeitgemässen Betrachtung verwenden, dass bei
grossem Unterschied von s2 zu s1 der Winkel w1 und die Seitenlänge s1 im
wesentlichen wirkungslos sind, das resultierende Quadrat wird stets
einen Viertel des Quadrats w2,s2 ausmachen:
GraphicsGrid[{Table[finslerHadwiger[-81, 60, 210, 6 10^n], {n, 0, 3}]}]
Grüsse
Udo.
finslerHadwigerEvolution.jpg
Description: JPEG image
_______________________________________________ DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch http://www.mathematica.ch/mailman/listinfo/demug Archiv: http://www.mathematica.ch/archiv.html
