Group Abstract Group Abstract

Message Boards Message Boards

Notebook prompts that elicit complete solutions and interpret equations in PDF file

Posted 2 years ago

I have limited math skills and am working on developing an animated visual of a non-standard physics concept. To achieve this, I am using AI and Mathematica. However, I'm facing a challenge as the 3D model I need was developed by a mathematician 20 years ago using MathCAD 11, which is no longer available. To address this issue, I presented a Chat-enabled Notebook with the relevant prompt:

Can you produce the function to match this graphic: https://sota.aetherwizard.com/images/Book/spin_2.jpg ? It represents 4 tubular loxodromes plotted over the surface of two adjacent spheres. The surface area of the four tubular loxodromes equals the surface area of the two spheres. Make sure the tubular loxodromes are centered on the sphere's surface. Make each sphere and each loxodrome a different color. See if you can understand the equations for this project at this page: https://sota.aetherwizard.com/images/MathCAD/Aether_Unit_graphics.pdf

I tried using the chatbot to interpret a graphic image and a PDF file containing MathCAD equations that describe the 3D graphic, but it only partially succeeded. Unfortunately, I am not able to write the equations myself, so I am wondering if there is a better way to phrase my prompt to get a complete solution.

POSTED BY: David Thomson
6 Replies

Sorry I forgot this line:

fsc[r_, \[Theta]_, \[CurlyPhi]_] = 
 FromSphericalCoordinates[{r, \[Theta], \[CurlyPhi]}];
POSTED BY: Gianluca Gorni

Here is a first attempt:

Clear[l, h1, g1];
sphereRadius = 13;
tubeRadius = 1;
l = 2;
h1[t_] = t;
g1[t_] = t/l;
Graphics3D[{{Opacity[.5], Sphere[{0, 0, 0}, sphereRadius]}, Thick, 
  Blue, Tube[
   Table[fsc[sphereRadius, g1[t], h1[t]], {t, 0, 2 Pi, Pi/40}], 
   tubeRadius],
  RGBColor[.36, .78, .72], 
  Tube[Table[
    fsc[sphereRadius, g1[t], -h1[t] + Pi], {t, 0, 2 Pi, Pi/40}], 
   tubeRadius]}]
POSTED BY: Gianluca Gorni
Posted 2 years ago

I shared the code to display what the chat-enabled notebook is creating, but it's not generating loxodromes like it should. The AI insists that it's producing the desired output, but that's not the case.

POSTED BY: David Thomson
POSTED BY: Gianluca Gorni
Posted 2 years ago

I tried running the code, and then turning the new code back into another chat-enabled prompt. After several iterations, I am now to this point, which still has errors:

Improve the following code to represent 4 tubular loxodromes plotted over the surface of two adjacent spheres. The surface area of the four tubular loxodromes equals the surface area of the two spheres. Make sure the tubular loxodromes are centered on the sphere's surface. Make each sphere and each loxodrome a different color. The final image should look like this image: https://sota.aetherwizard.com/images/Book/spin_2.jpg

fsc[r_, \[Theta]_, \[CurlyPhi]_] := {r*Cos[\[Theta]]*Sin[\[CurlyPhi]], r*Sin[\[Theta]]*Sin[\[CurlyPhi]], r*Cos[\[CurlyPhi]]};

sphereRadius = 13;
tubeRadius = sphereRadius^2 / (2 * Pi * sphereRadius);
l = 2 * Pi * sphereRadius * Sqrt[1 + Tan[45 Degree]^2]; (* Length of loxodromes *)

h1[t_] := t;
g1[t_] := t/l;

plot1 = ParametricPlot3D[
    fsc[sphereRadius, g1[t], h1[t]], {t, 0, l},
    PlotStyle -> Directive[Blue, Tube[tubeRadius]],
    PlotRange -> All
];

plot2 = ParametricPlot3D[
    fsc[sphereRadius, g1[t], -h1[t] + Pi], {t, 0, l},
    PlotStyle -> Directive[Yellow, Tube[tubeRadius]],
    PlotRange -> All
];

plot3 = ParametricPlot3D[
    fsc[sphereRadius, g1[t] + Pi/2, h1[t]] + {2*sphereRadius, 0, 0}, {t, 0, l},
    PlotStyle -> Directive[Cyan, Tube[tubeRadius]],
    PlotRange -> All
];

plot4 = ParametricPlot3D[
    fsc[sphereRadius, g1[t] + Pi/2, -h1[t] + Pi] + {2*sphereRadius, 0, 0}, {t, 0, l},
   Style -> Directive[Magenta, Tube[tubeRadius]],
    PlotRange -> All
];

Show[
    Graphics3D[
        {Opacity[.5], Red, Sphere[{0, 0, 0}, sphereRadius]},
        {Opacity[.5], Green, Sphere[{2*sphereRadius, 0, 0}, sphereRadius]}
    ],
    plot1,
    plot2,
    plot3,
    plot4,
    PlotLabel -> "Tubular Loxodromes on Spheres",
    AxesLabel -> {"x", "y", "z"},
    Axes -> True,
    Boxed -> True,
    ImageSize -> 400,
    PlotLegends -> {"Sphere 1", "Sphere 2", "Loxodrome 1", "Loxodrome 2", "Loxodrome 3", "Loxodrome 4"}
]
POSTED BY: David Thomson
Posted 2 years ago
POSTED BY: David Thomson
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard