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