0
$\begingroup$

Is there someone who uses Mathematica, and can help me to generate these images for a project? We don't have free access from the university and I can't find other free generators to be able to represent surfaces with genus 2 and 3. Thank you so much! Here are the codes:

With[{R = 1.2, r = 1/2, a = Sqrt[2]}, 
 ContourPlot3D[-a^2 + ((-r^2 + R^2)^2 - 
       2 (r^2 + R^2) ((-r - R + x)^2 + y^2) + 
       2 (-r^2 + R^2) z^2 + ((-r - R + x)^2 + y^2 + z^2)^2) ((-r^2 + 
          R^2)^2 - 2 (r^2 + R^2) ((r + R + x)^2 + y^2) + 
       2 (-r^2 + R^2) z^2 + ((r + R + x)^2 + y^2 + z^2)^2) == 
   0, {x, -2 (r + R), 2 (r + R)}, {y, -(r + R), (r + R)}, {z, -r - a, 
   r + a}, BoxRatios -> Automatic, PlotPoints -> 35, 
  MeshStyle -> Opacity[.2], 
  ContourStyle -> 
   Directive[Blue, Opacity[0.8], Specularity[White, 30]], 
  Boxed -> False, Axes -> False]]

and

torusImplicit[{x_, y_, z_}, R_, r_] = (x^2 + y^2 + z^2)^2 - 
   2 (R^2 + r^2) (x^2 + y^2) + 2 (R^2 - r^2) z^2 + (R^2 - r^2)^2;
build[n_] := 
  Module[{f, cp, polys, cartPolys, cartPolys1},(*implicit polynomial*) 
   f = Product[
      torusImplicit[{x - 1.5 Cos[i 2 Pi/n], y - 1.5 Sin[i 2 Pi/n], z},
        1, 1/4], {i, 0, n - 1}] - 10; 
   cp = ContourPlot3D[
     Evaluate[f == 0], {x, -3, 3}, {y, -3, 3}, {z, -1/2, 1/2}, 
     BoxRatios -> Automatic, PlotPoints -> 35, 
     MeshStyle -> Opacity[.2], 
     ContourStyle -> 
      Directive[Blue, Opacity[0.8], Specularity[White, 30]], 
     Boxed -> False, Axes -> False]];
build[3]
Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ Can you make a free cloud account at Wolfram Cloud? $\endgroup$
    – Syed
    May 26, 2022 at 7:17
  • 2
    $\begingroup$ I’m voting to close this question because it does not fit into StackExchange. $\endgroup$
    – Szabolcs
    May 26, 2022 at 11:26
  • $\begingroup$ I certainly sympathise with the request, but StackExchange has a very specific organization and this simply doesn't fit into its QA format. The chatroom or Wolfram Community would be a good place to ask. As said in the above comment, you can generate the plots using the Wolfram Cloud. $\endgroup$
    – Szabolcs
    May 26, 2022 at 11:27

1 Answer 1

Reset to default
1
$\begingroup$

Here are the plots if these you wish:

enter image description here

enter image description here

Improve this answer
$\endgroup$

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