Generalization of Gauss map not plotting all
- To: mathgroup at smc.vnet.net
- Subject: [mg124138] Generalization of Gauss map not plotting all
- From: Roger Bagula <roger.bagula at gmail.com>
- Date: Tue, 10 Jan 2012 06:02:25 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
I derived this combinatorial based generalization
of the 3d Gauss Map.
based on rationals {a,b,c} such that:
a^n+b^n+c^n=1
I was wanting the cube like surface that n=10
should give. My plotting is only 1/4 of the whole surface:
Mathematica:
Table[Table[Binomial[n, m], {m, 1, n, 2}], {n, 0, 10}]
Table[Table[Binomial[n, m], {m, 1, n, 2}], {n, 0, 10, 2}]
Flatten[%]
f[x_, r_,
n_] = (2*x^n*Sum[Binomial[n, m]*r^(n*m - n), {m, 1, n, 2}])^(1/n)
Table[FullSimplify[
ExpandAll[((f[y, r, n]/(1 + r^n))^n + (f[x, r, n]/(1 + r^n))^
n + ((1 - r^n)/(1 + r^n))^n) /. r -> (x^n + y^n)^(1/n)]], {n,
1, 10}]
(* Gauss Map*)
ga = ParametricPlot3D[{2*x/(1 + x^2 + y^2),
2*y/(1 + x^2 + y^2), (1 - x^2 - y^2)/(1 + x^2 + y^2)}, {x, -20,
20}, {y, -20, 20}, Boxed -> False, Axes -> False, Mesh -> False,
ColorFunction -> "ThermometerColors", PlotPoints -> 60,
PlotRange -> All]
(* plotting the generalizations to n=10*)
Table[ParametricPlot3D[{f[x, (x^n + y^n)^(1/n), n]/(1 + x^n + y^n),
f[y, (x^n + y^n)^(1/n),
n]/(1 + x^n + y^n), (1 - x^n - y^n)/(1 + x^n + y^n)}, {x, -20,
20}, {y, -20, 20}, Boxed -> False, Axes -> False, Mesh -> False,
PlotPoints -> 60, PlotRange -> All], {n, 1, 10}]
First I derived the projective line versions:
The idea is to get a rational pair (a,b)
in the one variable x such that:
a^n+b^n=1
The limiting function is such that the curve becomes a square:
a->Cos[x]/(Abs[Cos[x]]+Abs[Sin[x])
b->Sin[x]/(Abs[Cos[x]]+Abs[Sin[x])
Mathematica:
Table[Table[Binomial[n, m], {m, 1, n, 2}], {n, 0, 10}]
f[x_, n_] = (2*x^n*Sum[Binomial[n, m]*x^(n*m - n), {m, 1, n, 2}])^(1/
n)
Table[FullSimplify[
ExpandAll[(f[x, n]/(1 + x^n))^n + ((1 - x^n)/(1 + x^n))^n]], {n, 1,
10}]
Table[ParametricPlot[{f[x,
n]/(1 + x^n), (1 - x^n)/(1 + x^n)}, {x, -20, 20},
PlotRange -> {{-1.25, 1.25}, {-1.25, 1.25}}], {n, 1, 10}]
Show[%]
Table[ParametricPlot3D[{Sin[t]*f[x, n]/(1 + x^n),
Sin[t]*(1 - x^n)/(1 + x^n), Cos[t]}, {x, -20, 20}, {t, -Pi, Pi},
PlotRange -> {{-1.25, 1.25}, {-1.25, 1.25}}, Boxed -> False,
Axes -> False, Mesh -> False, ColorFunction -> "ThermometerColors",
PlotPoints -> 60], {n, 1, 10}]