6
$\begingroup$

In this program I am rotating a rhombus about the origin, in a normed non-Euclidean flat metric space :

$ ||x||_n =(|x_1| {}^n+|x_2| {}^n){}^{1/n} $ , with $ n=\frac{1}{3} $

The rotation preserves radial distances from the origin to the points onto the rhombus and of course, forces to change its shape:

  n = 1/3; a = -Sqrt[3]; b = 1.5; 
  graph1 = Manipulate[ListPlot[
     Table[{{(b*(Abs[Cos[θ]^n] + Abs[Sin[θ]^n])^(1/n)*Cos[θ + ϕ])/
         (((-a)*Cos[θ] + Sin[θ])*(Abs[Cos[θ + ϕ]^n] + Abs[Sin[θ + ϕ]^n])^(1/n)), 
        (b*(Abs[Cos[θ]^n] + Abs[Sin[θ]^n])^(1/n)*Sin[θ + ϕ])/
         (((-a)*Cos[θ] + Sin[θ])*(Abs[Cos[θ + ϕ]^n] + Abs[Sin[θ + ϕ]^n])^(1/n))}, 
       {(b*(Abs[Cos[θ + Pi/2]^n] + Abs[Sin[θ + Pi/2]^n])^(1/n)*Cos[θ + Pi/2 + ϕ])/
         ((a*Cos[θ + Pi/2] + Sin[θ + Pi/2])*(Abs[Cos[θ + Pi/2 + ϕ]^n] + 
            Abs[Sin[θ + Pi/2 + ϕ]^n])^(1/n)), 
        (b*(Abs[Cos[θ + Pi/2]^n] + Abs[Sin[θ + Pi/2]^n])^(1/n)*Sin[θ + Pi/2 + ϕ])/
         ((a*Cos[θ + Pi/2] + Sin[θ + Pi/2])*(Abs[Cos[θ + Pi/2 + ϕ]^n] + 
            Abs[Sin[θ + Pi/2 + ϕ]^n])^(1/n))}, 
       {((-b)*(Abs[Cos[θ + (2*Pi)/2]^n] + Abs[Sin[θ + (2*Pi)/2]^n])^(1/n)*
          Cos[θ + (2*Pi)/2 + ϕ])/(((-a)*Cos[θ + (2*Pi)/2] + Sin[θ + (2*Pi)/2])*
          (Abs[Cos[θ + (2*Pi)/2 + ϕ]^n] + Abs[Sin[θ + (2*Pi)/2 + ϕ]^n])^(1/n)), 
        ((-b)*(Abs[Cos[θ + (2*Pi)/2]^n] + Abs[Sin[θ + (2*Pi)/2]^n])^(1/n)*
          Sin[θ + (2*Pi)/2 + ϕ])/(((-a)*Cos[θ + (2*Pi)/2] + Sin[θ + (2*Pi)/2])*
          (Abs[Cos[θ + (2*Pi)/2 + ϕ]^n] + Abs[Sin[θ + (2*Pi)/2 + ϕ]^n])^(1/n))}, 
       {((-b)*(Abs[Cos[θ + (3*Pi)/2]^n] + Abs[Sin[θ + (3*Pi)/2]^n])^(1/n)*
          Cos[θ + (3*Pi)/2 + ϕ])/((a*Cos[θ + (3*Pi)/2] + Sin[θ + (3*Pi)/2])*
          (Abs[Cos[θ + (3*Pi)/2 + ϕ]^n] + Abs[Sin[θ + (3*Pi)/2 + ϕ]^n])^(1/n)), 
        ((-b)*(Abs[Cos[θ + (3*Pi)/2]^n] + Abs[Sin[θ + (3*Pi)/2]^n])^(1/n)*
          Sin[θ + (3*Pi)/2 + ϕ])/((a*Cos[θ + (3*Pi)/2] + Sin[θ + (3*Pi)/2])*
          (Abs[Cos[θ + (3*Pi)/2 + ϕ]^n] + Abs[Sin[θ + (3*Pi)/2 + ϕ]^n])^(1/n))}}, 
      {θ, 0, Pi/2, 0.005}], AspectRatio -> None, AxesOrigin -> {0, 0}, Axes -> False, 
     PlotStyle -> PointSize[0.005], PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}}], 
    {ϕ, 0, 2*Pi, 0.01}]

enter image description here

My question is, how to fill the space inside the ever-changing shape of rhombus as it rotates, to make the graphic image more presentable?

I understand that this can be a very hard question to answer..

$\endgroup$

2 Answers 2

7
$\begingroup$
  • We use Catenate@Transpose@data to construct a cyclic path to construct a polygon to fill the region.
Clear["Global`*"];
n = 1/3; a = -Sqrt[3]; b = 1.5; 
data[ϕ_] = 
 Table[{{(b*(Abs[Cos[θ]^n] + Abs[Sin[θ]^n])^(1/n)*
       Cos[θ + ϕ])/(((-a)*Cos[θ] + 
         Sin[θ])*(Abs[Cos[θ + ϕ]^n] + 
          Abs[Sin[θ + ϕ]^n])^(1/
          n)), (b*(Abs[Cos[θ]^n] + Abs[Sin[θ]^n])^(1/n)*
       Sin[θ + ϕ])/(((-a)*Cos[θ] + 
         Sin[θ])*(Abs[Cos[θ + ϕ]^n] + 
          Abs[Sin[θ + ϕ]^n])^(1/
          n))}, {(b*(Abs[Cos[θ + Pi/2]^n] + 
          Abs[Sin[θ + Pi/2]^n])^(1/n)*
       Cos[θ + Pi/2 + ϕ])/((a*Cos[θ + Pi/2] + 
         Sin[θ + Pi/2])*(Abs[Cos[θ + Pi/2 + ϕ]^n] +
           Abs[Sin[θ + Pi/2 + ϕ]^n])^(1/
          n)), (b*(Abs[Cos[θ + Pi/2]^n] + 
          Abs[Sin[θ + Pi/2]^n])^(1/n)*
       Sin[θ + Pi/2 + ϕ])/((a*Cos[θ + Pi/2] + 
         Sin[θ + Pi/2])*(Abs[Cos[θ + Pi/2 + ϕ]^n] +
           Abs[Sin[θ + Pi/2 + ϕ]^n])^(1/
          n))}, {((-b)*(Abs[Cos[θ + (2*Pi)/2]^n] + 
          Abs[Sin[θ + (2*Pi)/2]^n])^(1/n)*
       Cos[θ + (2*Pi)/2 + ϕ])/(((-a)*
          Cos[θ + (2*Pi)/2] + 
         Sin[θ + (2*Pi)/2])*(Abs[
           Cos[θ + (2*Pi)/2 + ϕ]^n] + 
          Abs[Sin[θ + (2*Pi)/2 + ϕ]^n])^(1/
          n)), ((-b)*(Abs[Cos[θ + (2*Pi)/2]^n] + 
          Abs[Sin[θ + (2*Pi)/2]^n])^(1/n)*
       Sin[θ + (2*Pi)/2 + ϕ])/(((-a)*
          Cos[θ + (2*Pi)/2] + 
         Sin[θ + (2*Pi)/2])*(Abs[
           Cos[θ + (2*Pi)/2 + ϕ]^n] + 
          Abs[Sin[θ + (2*Pi)/2 + ϕ]^n])^(1/
          n))}, {((-b)*(Abs[Cos[θ + (3*Pi)/2]^n] + 
          Abs[Sin[θ + (3*Pi)/2]^n])^(1/n)*
       Cos[θ + (3*Pi)/2 + ϕ])/((a*
          Cos[θ + (3*Pi)/2] + 
         Sin[θ + (3*Pi)/2])*(Abs[
           Cos[θ + (3*Pi)/2 + ϕ]^n] + 
          Abs[Sin[θ + (3*Pi)/2 + ϕ]^n])^(1/
          n)), ((-b)*(Abs[Cos[θ + (3*Pi)/2]^n] + 
          Abs[Sin[θ + (3*Pi)/2]^n])^(1/n)*
       Sin[θ + (3*Pi)/2 + ϕ])/((a*
          Cos[θ + (3*Pi)/2] + 
         Sin[θ + (3*Pi)/2])*(Abs[
           Cos[θ + (3*Pi)/2 + ϕ]^n] + 
          Abs[Sin[θ + (3*Pi)/2 + ϕ]^n])^(1/
          n))}}, {θ, 0, Pi/2, 0.005}];
Manipulate[
 Module[{pts}, pts = data[ϕ]; 
  ListPlot[pts, 
   Prolog -> {Opacity[.2], Green, 
     Polygon[Catenate@Transpose@pts]}]], {ϕ, 0, 2*Pi, 0.01}]

enter image description here

$\endgroup$
1
$\begingroup$
$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global`*"]

n = 1/3; a = -Sqrt[3]; b = 3/2;

graph1 = Manipulate[
  ListLinePlot[
   Evaluate[
    Table[#, {θ, 0, Pi/2, 
        0.005}] & /@ {{(b*(Abs[Cos[θ]^n] + 
             Abs[Sin[θ]^n])^(1/n)*
          Cos[θ + ϕ])/(((-a)*Cos[θ] + 
            Sin[θ])*(Abs[Cos[θ + ϕ]^n] + 
             Abs[Sin[θ + ϕ]^n])^(1/
             n)), (b*(Abs[Cos[θ]^n] + Abs[Sin[θ]^n])^(1/
             n)*Sin[θ + ϕ])/(((-a)*Cos[θ] + 
            Sin[θ])*(Abs[Cos[θ + ϕ]^n] + 
             Abs[Sin[θ + ϕ]^n])^(1/
             n))}, {(b*(Abs[Cos[θ + Pi/2]^n] + 
             Abs[Sin[θ + Pi/2]^n])^(1/n)*
          Cos[θ + Pi/2 + ϕ])/((a*Cos[θ + Pi/2] + 
            Sin[θ + Pi/2])*(Abs[
              Cos[θ + Pi/2 + ϕ]^n] + 
             Abs[Sin[θ + Pi/2 + ϕ]^n])^(1/
             n)), (b*(Abs[Cos[θ + Pi/2]^n] + 
             Abs[Sin[θ + Pi/2]^n])^(1/n)*
          Sin[θ + Pi/2 + ϕ])/((a*Cos[θ + Pi/2] + 
            Sin[θ + Pi/2])*(Abs[
              Cos[θ + Pi/2 + ϕ]^n] + 
             Abs[Sin[θ + Pi/2 + ϕ]^n])^(1/
             n))}, {((-b)*(Abs[Cos[θ + (2*Pi)/2]^n] + 
             Abs[Sin[θ + (2*Pi)/2]^n])^(1/n)*
          Cos[θ + (2*Pi)/2 + ϕ])/(((-a)*
             Cos[θ + (2*Pi)/2] + 
            Sin[θ + (2*Pi)/2])*(Abs[
              Cos[θ + (2*Pi)/2 + ϕ]^n] + 
             Abs[Sin[θ + (2*Pi)/2 + ϕ]^n])^(1/
             n)), ((-b)*(Abs[Cos[θ + (2*Pi)/2]^n] + 
             Abs[Sin[θ + (2*Pi)/2]^n])^(1/n)*
          Sin[θ + (2*Pi)/2 + ϕ])/(((-a)*
             Cos[θ + (2*Pi)/2] + 
            Sin[θ + (2*Pi)/2])*(Abs[
              Cos[θ + (2*Pi)/2 + ϕ]^n] + 
             Abs[Sin[θ + (2*Pi)/2 + ϕ]^n])^(1/
             n))}, {((-b)*(Abs[Cos[θ + (3*Pi)/2]^n] + 
             Abs[Sin[θ + (3*Pi)/2]^n])^(1/n)*
          Cos[θ + (3*Pi)/2 + ϕ])/((a*
             Cos[θ + (3*Pi)/2] + 
            Sin[θ + (3*Pi)/2])*(Abs[
              Cos[θ + (3*Pi)/2 + ϕ]^n] + 
             Abs[Sin[θ + (3*Pi)/2 + ϕ]^n])^(1/
             n)), ((-b)*(Abs[Cos[θ + (3*Pi)/2]^n] + 
             Abs[Sin[θ + (3*Pi)/2]^n])^(1/n)*
          Sin[θ + (3*Pi)/2 + ϕ])/((a*
             Cos[θ + (3*Pi)/2] + 
            Sin[θ + (3*Pi)/2])*(Abs[
              Cos[θ + (3*Pi)/2 + ϕ]^n] + 
             Abs[Sin[θ + (3*Pi)/2 + ϕ]^n])^(1/n))}}],
   Axes -> False,
   PlotStyle -> style,
   AspectRatio -> 1,
   Filling -> Axis,
   PlotRange -> {{-4, 4}, {-4, 4}}],
  {{ϕ, 1}, 0, 2*Pi, 0.01, Appearance -> "Labeled"},
  {{style, ColorData[97][1]}, {ColorData[97][1], 
    Automatic -> "Multi"}},
  TrackedSymbols :> {ϕ, style}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.