Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

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

Search the Archive

Re: REQ: Kuratowski graphs on Möbius band and torus

  • To: mathgroup at smc.vnet.net
  • Subject: [mg80484] Re: REQ: Kuratowski graphs on Möbius band and torus
  • From: m.r at inbox.ru
  • Date: Thu, 23 Aug 2007 01:14:18 -0400 (EDT)
  • References: <faguda$97e$1@smc.vnet.net>

On Aug 22, 4:07 am, Yannis <yan... at polytoniko.gr> wrote:
> Hi,
>
> I'm preparing a course on graphs and I would like to show my students
> how the K_5 and K_{3,3} graphs can be represented on a M=F6bius band and
> on a torus (with one hole). I can draw it on the blackboard but I
> think it would be more attractive to see it drawn by Mathematica. As I
> don't have access to the software, could someone among you be so kind
> and prepare those four 3D images for me? That would be very kind!
>
> K_5 on M=F6bius band
> K_{3,3} on M=F6bius band
> K_5 on torus
> K_{3,3} on torus
>
> Or maybe those images already exist somewhere on the Web, then please
> point me to them.
>
> Thank you very much in advance!
>
> My email address is: yannis.haralambous at enst-bretagne.fr

Not exactly what you're looking for, but this is interactive:

DynamicModule[{R = 3, r = 1, S, seg, colpt, gr,
  p1, p2, p3, q1, q2, q3},
 S[u_, v_] := {(R + r Cos[2 Pi v]) Cos[2 Pi u],
   (R + r Cos[2 Pi v]) Sin[2 Pi u], r Sin[2 Pi v]};
 seg[a_, b_, t_] := ((b - a) - IntegerPart[2. (b - a)]) t + a;
 colpt[L_] :=
  Transpose@ {Hue /@ (Range@ Length@ L/Length@ L), Point /@ L};
 gr = ParametricPlot3D[S[u, v], {u, 0, 1}, {v, 0, 1},
   Mesh -> False, PlotPoints -> {20, 10}, PlotStyle -> Opacity[.5]];
 {p1, p2, p3, q1, q2, q3} =
  {{1/6, 1/4}, {1/2, 1/4}, {5/6, 1/4},
   {1/6, 3/4}, {1/2, 3/4}, {5/6, 3/4}};
 Row@ {LocatorPane[Dynamic@ {p1, p2, p3, q1, q2, q3},
    Graphics[
     {Line[Dynamic@ Tuples@ {{p1, p2, p3}, {q1, q2, q3}}],
      AbsolutePointSize[5],
      Dynamic@ colpt@ {p1, p2, p3, q1, q2, q3}},
     ImageSize -> 400, PlotRange -> {{-.1, 1.1}, {-.1, 1.1}}],
    {{0, 0}, {1, 1}}],
   Graphics3D[{First@ gr,
     Dynamic@ (ParametricPlot3D[
           S[seg[#2[[1]], #[[1]], t], seg[#2[[2]], #[[2]], t]] //
            Evaluate,
           {t, 0, 1}, PlotStyle -> Thick]& @@@
         Tuples@ {{p1, p2, p3}, {q1, q2, q3}})[[All, 1]],
     AbsolutePointSize[8],
     Dynamic@ colpt[S @@@ {p1, p2, p3, q1, q2, q3}]},
    Axes -> False, Boxed -> False, ImageSize -> 400,
    ViewAngle -> Pi/10]}
 ]

Maxim Rytin
m.r at inbox.ru



  • Prev by Date: Re: RE: Re: Missing information in Mathematica 6.0 Documentation
  • Next by Date: Re: fit a BinomialDistribution to exptl data?
  • Previous by thread: Re: Manipulate a VectorFieldPlot3D
  • Next by thread: recording singularities of NDSolve