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