counting rotopes in mathematica

Discuss interdimensional programming, Java applets and so forth.

counting rotopes in mathematica

Postby PWrong » Mon Jan 16, 2006 11:24 am

This mathematica code finds all the toratopes and beasts in n dimensions. To find the other half of the rotopes, you just take out the first and last bracket. For instance, the glome is [1,1,1,1] = 4. Take out the brackets and you get the tesseract: 1,1,1,1

By the way, this code interprets the brackets as functions, so the cylinder is f[2,1] instead of (2,1). You can define f to do what you want with the toratope. For instance, to just look at the toratope, use f -> " " to make f invisible. You can also find the dimension of a toratope by using f -> Plus

This bit finds the partitions of n by solving the equation x_1 + 2 x_2 + 3 x_3 + ... + n x_n = n, for the x_i. Each partition is a rototope. I think there's an add-on to mathematica that does this a lot faster.

Partitions[n_] := Table[ x[i], {i, 1, n}] /. FindInstance[Table[ x[i], {i, 1, n}].Table[
i, {i, 1, n}] == n && Apply[And, Table[ x[i] ≥ 0, {i, 1, n}]],
Table[ x[i], {i, 1, n}], Integers, PartitionsP[n]]

Example:
Partitions[4] ->
{{0, 0, 0, 1}, {0, 2, 0, 0}, {1, 0, 1, 0}, {2, 1, 0, 0}, {4, 0, 0, 0}}

This expresses the partitions of n in a more recognisable form.

LPartitions[0] := {{}}
LPartitions[n_] := (ps = Partitions[n] ; Table[Flatten[Table[ Table[j, {ps[[
k]][[j]]}], {j, 1, n}]], {k, Length[ps]}])

example:
LPartitions[4] ->
{{4}, {2, 2}, {1, 3}, {1, 1, 2}, {1, 1, 1, 1}}

Now we supply the list of toratopes for 0 and 1 dimensions.
Toratopes[0] := {0}
Toratopes[1] := {1}

Here's the main functions. Sorry they're so messy. I'm not too experienced with mathematica yet.

MakeToratope takes a partition and finds all the toratopes that can be made by replacing each sphere with a toratope. For instance, consider the glomoduosphere: (3,3,4). We can replace each sphere with a torus, and the glome with any of the five 4D torotopes.

MakeToratope[p_] := (ff[x_] := Outer[f,
Sequence @@ x, 1] ; Union[ Map[ Sort, Flatten[ff[Map[Toratopes, p]]]]])

example:
MakeToratope[{3, 3, 4}] /. f -> ""
{[3, 3, 4],
[3, 3, [1, 3]],
[3, 3, [1, [2, 1]]],
[3, 3, [2, 2]],
[3, 3, [1, 1, 2]],
[3, 4, [2, 1]],
[3, [1, 3], [2, 1]],
[3, [1, [2, 1]], [2, 1]],
[3, [2, 1], [2, 2]],
[3, [2, 1], [1, 1, 2]],
[4, [2, 1], [2, 1]],
[[1, 3], [2, 1], [2, 1]],
[[1, [2, 1]], [2, 1], [2, 1]],
[[2, 1], [2, 1], [2, 2]],
[[2, 1], [2, 1], [1, 1, 2]]}

Toratope takes all the partitions of n and returns all of the toratopes (exactly half of all the rotopes).

Toratopes[n_] := (ps = Rest[ LPartitions[n]] ; Flatten[Map[MakeToratope,
ps] /. Table[f[Sequence @@ Table[1, {k}]] -> k, {k, n}]])

example:
Toratopes[6] /. f -> " "

{[3, 3], [3, [2, 1]],
[[2, 1], [2, 1]],
[2, 4], [2, [1, 3]],
[2, [1, [2, 1]]],
[2, [2, 2]],
[2, [1, 1, 2]],
[2, 2, 2],
[1, 5],
[1, [1, 4]],
[1, [1, [1, 3]]],
[1, [1, [1, [2, 1]]]],
[1, [1, [2, 2]]],
[1, [1, [1, 1, 2]]],
[1, [2, 3]],
[1, [2, [2, 1]]],
[1, [1, 1, 3]],
[1, [1, 1, [2, 1]]],
[1, [1, 2, 2]],
[1, [1, 1, 1, 2]],
[1, 2, 3],
[1, 2, [2, 1]],
[1, 1, 4],
[1, 1, [1, 3]],
[1, 1, [1, [2, 1]]],
[1, 1, [2, 2]],
[1, 1, [1, 1, 2]],
[1, 1, 2, 2],
[1, 1, 1, 3],
[1, 1, 1, [2, 1]],
[1, 1, 1, 1, 2],
6}
User avatar
PWrong
Pentonian
 
Posts: 1599
Joined: Fri Jan 30, 2004 8:21 am
Location: Perth, Australia

Return to Programming

Who is online

Users browsing this forum: No registered users and 5 guests