Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2012

[Date Index] [Thread Index] [Author Index]

Search the Archive

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}]



  • Prev by Date: Re: more plotting peculiarities
  • Next by Date: Re: Mantaining the same form
  • Previous by thread: Re: Memory usage of a Sierpinski triangle algorithm
  • Next by thread: select 1st column element based on criteria in 2nd column in mathematica