Publishing an article on rotatopes and toratopes

Discussion of shapes with curves and holes in various dimensions.

Re: Publishing an article on rotatopes and toratopes

Postby PWrong » Sat Sep 06, 2014 2:35 am

As many as you like.
User avatar
PWrong
Pentonian
 
Posts: 1599
Joined: Fri Jan 30, 2004 8:21 am
Location: Perth, Australia

Re: Publishing an article on rotatopes and toratopes

Postby ICN5D » Sat Sep 06, 2014 6:30 pm

Oh, really!? Well, then, I must check this out. I can write fewer explore functions, with more control over the shape in a single one. That'll be a major benefit with making gifs, in helping with keeping the same shape in view.
It is by will alone, I set my donuts in motion
ICN5D
Pentonian
 
Posts: 1135
Joined: Mon Jul 28, 2008 4:25 am
Location: the Land of Flowers

Re: Publishing an article on rotatopes and toratopes

Postby PWrong » Mon Sep 08, 2014 7:06 am

The only issue is it might be very slow to animate these large functions. It might be OK on a faster computer, but on mine it crashes if I try to animate a tiger. But you could use the Mathematica code to generate the equations, and then use another program for the animations. Also I haven't been able to get it to calculate any volumes or surface areas yet, except some poor numerical estimates. I'm also trying to figure out a way to generate the notations for all the toratopes in a given dimension.
User avatar
PWrong
Pentonian
 
Posts: 1599
Joined: Fri Jan 30, 2004 8:21 am
Location: Perth, Australia

Re: Publishing an article on rotatopes and toratopes

Postby ICN5D » Tue Sep 09, 2014 12:53 am

That could be true. Since I haven't been able to play around with Mathematica, I don't know how well it renders. I guess my comp is fast, for 2007 when I got it. This also means it has surpassed the limit of its wear cycle. It's broke as hell. But, it does do a great job exploring up to 7D toratopes, without much render time in low-res for CalcPlot3D. If yours crashes on the tiger, maybe try out CalcPlot? From what I hear, it's exceptional with implicit functions. I've used the heck out of it, as you can tell.

I'm not sure if an equation generator is that necessary. Cool that it can do that! But, I find the good ole' fashion notation --> equation build tree effective enough. Plus, it helps refine your eye for the equation structure, not a bad thing. As for generating the notations automatically, that's exactly what I was looking for here . But then, Marek answered by enumerating the list up to 10D. I'd still be interested in over 10D, where at 11D the list is six thousand strong. What would be really neat, is a notation --> equation converter. When I decide to drop some $$$ on a nice fast computer, it'll help with big toratopes.

Just for the heck of it, see if your comp crashes in CalcPlot3D : http://web.monroecc.edu/calcNSF/

Tiger rotation function: (sqrt(x^2 + (y*sin(a))^2) - 2)^2 + (sqrt(z^2 + (y*cos(a))^2) - 2)^2 -0.5^2 = 0

set XYZ box = -4 , +4
set a = 0 ~ 1.57

render in 30 cubes

This is the only program I've been using, and found to work well. Right at 8D, if it's anything more complex than the tetratiger ((II)(II)(II)(II)) , it'll be really slow for animations.
It is by will alone, I set my donuts in motion
ICN5D
Pentonian
 
Posts: 1135
Joined: Mon Jul 28, 2008 4:25 am
Location: the Land of Flowers

Re: Publishing an article on rotatopes and toratopes

Postby PWrong » Tue Sep 09, 2014 2:14 pm

Generate closed toratopes:
Code: Select all
DeleteRotations[list_] :=
DeleteDuplicates[Map[Reverse[Sort[#]] &, list, 1]]
Toratopes[1] = {1};
Rotatopes[n_] := Rest[IntegerPartitions[n]]
ExpandRotatope[list_] := DeleteRotations[ Tuples[Map[Toratopes, list]]]
Toratopes[n_] := Reverse[Flatten[Map[ExpandRotatope, Rotatopes[n]], 1]]

Fancy toratopic notation:
Code: Select all
TStringList[1] = "I";
TStringList[list_] :=
Flatten[{"(", Table[TStringList[i], {i, list}], ")"}, 1]
ClosedToratopeNotation[list_] := StringJoin[TStringList[list]]
OpenToratopeNotation[list_] :=
StringJoin[ TStringList[list] // Most // Rest]
ToratopeList[n_] :=
If[n === 1, {"I"},
   Join[Map[OpenToratopeNotation, Toratopes[n]],
    Map[ClosedToratopeNotation, Toratopes[n]]]] // TableForm

Convert from list notation to Tor[] notation:
Code: Select all
T[1, pos_] := ToExpression[ StringJoin["x", Map[ToString, pos, 1]]]
T[list_, pos_] :=
Tor[ToExpression[StringJoin["r", Map[ToString, pos, 1]]], list]
TorNotation[list_] := Tor[r, MapIndexed[T , list, Infinity]]

Convert from Tor[] notation to a function:
Code: Select all
TorFunction[tor_] :=
If[tor[[0]] === Tor,
  Sqrt[Total[(Table[TorFunction[subtor], {subtor, tor[[2]]}])^2]] -
   tor[[1]], tor]
ToratopeFunction[tor_] := TorFunction[TorNotation[tor]]

Example:
Code: Select all
In[125]:= ToratopeFunction[{{1, 1}, {1, 1}}]

Out[125]= -R + Sqrt[(-r1 + Sqrt[x11^2 + x12^2])^2 + (-r2 + Sqrt[
    x21^2 + x22^2])^2]

Write this as a function of any variables:
Code: Select all
RList[tor_] :=
Sort[ToExpression[StringJoin["r", Map[ToString, #, 1]]] & /@
   Position[tor, _List]]
XList[tor_] :=
Sort[ToExpression[StringJoin["x", Map[ToString, #, 1]]] & /@
   Position[tor, 1]]

ToratopeFunctionVar[list_] :=
  Function[Evaluate[RList[list]],
  Evaluate[Function[Evaluate[XList[list]],
     Evaluate[ToratopeFunction[list]]]]]

Example:
Code: Select all
In[134]:=
ToratopeFunctionVar[{{1, 1}, {1, 1}}][R, Subscript[r, a], Subscript[r,
   b]][x, y, z, w]

Out[134]= -R + Sqrt[(Sqrt[x^2 + y^2] - Subscript[r, a])^2 + (Sqrt[
    w^2 + z^2] - Subscript[r, b])^2]

List of implicit equations for all closed toratopes in 5D:
Code: Select all
In[133]:= Map[ToratopeFunction[#] == 0 & , Toratopes[5]] // TableForm

Out[133]=
-R+Sqrt[x1^2+x2^2+x3^2+x4^2+x5^2]==0
-R+Sqrt[(-r1+Sqrt[x11^2+x12^2])^2+x2^2+x3^2+x4^2]==0
-R+Sqrt[(-r1+Sqrt[x11^2+x12^2])^2+(-r2+Sqrt[x21^2+x22^2])^2+x3^2]==0
-R+Sqrt[(-r1+Sqrt[(-r11+Sqrt[x111^2+x112^2])^2+x12^2])^2+x2^2+x3^2]==0
-R+Sqrt[(-r1+Sqrt[x11^2+x12^2+x13^2])^2+x2^2+x3^2]==0
-R+Sqrt[(-r1+Sqrt[(-r11+Sqrt[x111^2+x112^2])^2+x12^2])^2+(-r2+Sqrt[x21^2+x22^2])^2]==0
-R+Sqrt[(-r1+Sqrt[x11^2+x12^2+x13^2])^2+(-r2+Sqrt[x21^2+x22^2])^2]==0
-R+Sqrt[(-r1+Sqrt[(-r11+Sqrt[x111^2+x112^2+x113^2])^2+x12^2])^2+x2^2]==0
-R+Sqrt[(-r1+Sqrt[(-r11+Sqrt[(-r111+Sqrt[x1111^2+x1112^2])^2+x112^2])^2+x12^2])^2+x2^2]==0
-R+Sqrt[(-r1+Sqrt[(-r11+Sqrt[x111^2+x112^2])^2+(-r12+Sqrt[x121^2+x122^2])^2])^2+x2^2]==0
-R+Sqrt[(-r1+Sqrt[(-r11+Sqrt[x111^2+x112^2])^2+x12^2+x13^2])^2+x2^2]==0
-R+Sqrt[(-r1+Sqrt[x11^2+x12^2+x13^2+x14^2])^2+x2^2]==0
Last edited by PWrong on Tue Sep 09, 2014 2:19 pm, edited 1 time in total.
User avatar
PWrong
Pentonian
 
Posts: 1599
Joined: Fri Jan 30, 2004 8:21 am
Location: Perth, Australia

Re: Publishing an article on rotatopes and toratopes

Postby PWrong » Tue Sep 09, 2014 2:49 pm

Also, I worked out the way to stop it crashing is to use Evaluate to evaluate the function before plotting it. So for example
Code: Select all
Animate[
  ContourPlot3D[
   Evaluate[
    ToratopeFunctionVar[{{1, 1}, {1, 1}}][1, 3, 4][x, y Cos[t], z ,
      y Sin[t]] == 0], {x, -6, 6}, {y, -6, 6}, {z, -6, 6},
   PlotPoints -> 30], {t, 0, 2 \[Pi], 0.1}]

works a lot better than
Code: Select all
Animate[ContourPlot3D[
  ToratopeFunctionVar[{{1, 1}, {1, 1}}][1, 3, 4][x, y Cos[t], z ,
    y Sin[t]] == 0, {x, -6, 6}, {y, -6, 6}, {z, -6, 6},
  PlotPoints -> 30], {t, 0, 2 \[Pi], 0.1}]
User avatar
PWrong
Pentonian
 
Posts: 1599
Joined: Fri Jan 30, 2004 8:21 am
Location: Perth, Australia

Previous

Return to Toratopes

Who is online

Users browsing this forum: No registered users and 6 guests