Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

My problem starts from attempts at depicting overlapping lines of different thickness, i.e.

ClearAll[line1, line2, overlapping1, overlapping2, ov1Flat, ov2Flat]
line1 = Graphics[{Thickness[0.003], Blue, Line[{{0, 0}, {4, 1}}]}];
line2 = Graphics[{Thickness[0.03], Red, Line[{{0, 0}, {4, 1}}]}];
overlapping1 = Show[{line2, line1}];

overlapping lines 2d

I am often annotating parts of a plot with lines of varying thickness and my preferred method of projecting 2D plots onto 3D is by, well, projecting:

ov1Flat = Show[{ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}], overlapping1}];
Graphics3D@(N@First@ov1Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.})

enter image description here

This works really well for projecting Graphics objects comprised of polygons onto a plane but I am not happy with the behaviour of Line as a 3D object: lines of various thicknesses get turned into ugly cylinders and their overlap doesn't show too well. I know I can use Texture to do the same thing but I would like to avoid it. I'd need to adjust the position of a rasterized image which I'd need to rasterize to an acceptable quality etc - in short, I find it dirtier.

So I am looking for a failsafe rule that maps lines onto polygons that I can apply to a Graphics object before projecting it and turning it into a truly flat Graphics3D object.

In trying making a rule for lines consisting of two points, I got the following:

overlapping2 = 
  overlapping1 /. {pre1___, Thickness[a_], mid___, Line[c_], 
     post___} :> {pre1, mid, 
     Polygon[
      Transpose@(Transpose@c + 
          4 a (RotationMatrix[π/2].Normalize[
              Flatten@Differences@c]))~Join~
       Transpose@(Transpose@Reverse@c - 
          4 a (RotationMatrix[π/2].Normalize[
              Flatten@Differences@c]))]
     , post};
Show[overlapping2]

which probably has a million ways to break, is inefficient etc, but at least works for the toy example of a line consisting of a start and end point.

overlap2

This replicates the line quite well and once projected is still "flat" with the overlaps showing much better:

Show[Graphics3D@(N@
     First@Graphics@overlapping2 /. {x_?AtomQ, y_?AtomQ} -> {x, y, 
      2.}), Lighting -> "Neutral"]

line3D

but it doesn't like getting combined with other objects:

ov2Flat=Show[{ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}], overlapping2}];
Graphics3D@(N@First@ov2Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.})

projected line.

So my question in its most general form would be:

Is there a transformation rule that one can apply to a Graphics object so that the said object can be projected to a truly flat Graphics3D object (and look good)?

I know that for Text this would probably be impossible so something that has the right behaviour for Line and Point primitives would be great. And a "no" answer that would mean I have to use Texture is also OK but as I said, I want this to be a last resort.

----EDIT----

The reason I want to do the projection is so that I combine two and three dimensional plots. I am stuck with the toy example I made up (which isn't very well suited for this) but it should give an idea:

Show[{Plot3D[8 + Sin[y x], {x, -4, 4}, {y, -4, 4}, 
   MeshFunctions -> {(0.25 #1 - #2) &}, Mesh -> {{0}}, 
   MeshStyle -> {Blue, Thick}, PlotPoints -> 80],
  Graphics3D@(N@
      First@ov2Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.})}, 
 PlotRange -> All, BoxRatios -> {Automatic, Automatic, 6}]

projection3

----EDIT 2----

Ok, so the only way out seems to be offsetting each polygonised Line a little with respect to the overlapping line and all these lines with respect to the projected plane. I think @belisarius's rule based on the line colour is the simplest one to do that (especially if there's a lot of lines to go through) so I'm going with that.

share|improve this question
    
Does offsetting the z-value slightly do any good? –  Yves Klett Aug 15 '13 at 15:13
    
yeah, kind of does. But that means I'd have to project separately all "polygonised" lines from the rest of the graphics objects. I was kind of hoping for something more general. –  gpap Aug 15 '13 at 15:29
    
Sometimes adding Opacity[.99] or similar does also help, but the rendering of coincident polygons is problematic (see also mathematica.stackexchange.com/questions/15735/…) –  Yves Klett Aug 15 '13 at 15:51
    
Opacity[.99] doesn't really help but that is a very helpful link. –  gpap Aug 15 '13 at 16:18
    
The problem with this question is that it needs a little more motivation. If you are always drawing on a flat (level?) plane why not use a 2D plot? An offset from the plane is probably the best 3D solution and I don't understand the reason you're not satisfied with that. Do you have multiple planes with normals in different directions? –  David Park Aug 15 '13 at 17:49
show 3 more comments

3 Answers

up vote 3 down vote accepted

Just a quick fix:

s = Graphics3D@(N@First@ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}] /. 
                                          {x_? AtomQ, y_?AtomQ} -> {x, y, 3});
new = Graphics3D[(N@First@overlapping2 /. {x_?AtomQ, y_?AtomQ} -> {x, y, 3.1}), 
                                       PlotRange -> {{-4, 4}, {-4, 4}, {2, 4}}];

Show[{new, s, new}]

Mathematica graphics

Edit

If you chose your line colors (or any other line directive) to be unique, you may do the same without projecting separately:

Graphics3D@(N@
     First@ov2Flat /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.}) /. 
     {RGBColor[1., 0., 0.], Polygon[l_ ]} :> 
                      {RGBColor[1., 0., 0.], Polygon[Plus[#, {0, 0, .1}] & /@ l]}

Mathematica graphics

share|improve this answer
    
thanks a lot (+1) - I know this works but I was kind of hoping I wouldn't have to separately project lines and polygons. –  gpap Aug 15 '13 at 18:46
    
@gpap See edit please –  belisarius Aug 15 '13 at 22:41
    
this could work actually. The way it is, it would still run into the problem of the overlapping polygonised lines looking bad (if you try to overlap lines of comparable thickness you'll see what I mean). But it's fine as you can make a new rule based on whatever colour the top line has. –  gpap Aug 16 '13 at 9:23
    
@gpap Of course! The whole stupid idea is based on being able to pick each line by its color and manipulate the "projecting height" –  belisarius Aug 16 '13 at 12:47
add comment

Projection approach

One way to get the lines to show up nicely is to wrap them in Tube and then project these tubes down onto the plane. To do projections in a more general setting, I had written a function project as an answer to "How to make a drop-shadow for Graphics3D objects", which however needed some fixes for this answer.

So although the function project is overkill for this problem, I'll list it here and show how it can be applied:

Options[project] = {"ObjectCenter" -> {0, 0, 0}, "DarkShadow" -> True};

project[x_, direction_, normal_, OptionsPattern[]] := Module[
  {d, n, darkShadow, center},
  darkShadow = OptionValue["DarkShadow"];
  center = OptionValue["ObjectCenter"];
  d = Normalize[direction];
  n = Normalize[normal];
  x /. Graphics3D[gr_, opts___] :> Graphics3D[
     {
      If[darkShadow, Black],
      GeometricTransformation[
       If[darkShadow,
        gr /. {
          Glow[_] -> Glow[],

          r_?(MemberQ[{RGBColor, Hue, CMYKColor, GrayLevel}, 
               Head[#]] &) -> Black
          },
        gr
        ],
       Composition[
        TranslationTransform[direction + center],
        Quiet[Check[RotationTransform[{d, n}], Identity],
         {RotationMatrix::degen, RotationTransform::spln}
         ],
        ScalingTransform[10^-3, d],
        Quiet@Check[
          ScalingTransform[1./(n.d), n - (n.d) d],
          Identity
          ],
        TranslationTransform[-center]
        ]
       ]
      },
     opts
     ]
  ]

Here are your definitions of the lines, and my way of translating them to 3D:

line1 = Graphics[{Thickness[0.003], Blue, Line[{{0, 0}, {4, 1}}]}];
line2 = Graphics[{Thickness[0.03], Red, Line[{{0, 0}, {4, 1}}]}];

line1new = 
  Graphics3D[N[First@line1] /. {x_?AtomQ, y_?AtomQ} -> {x, y, 2.}] /. 
   Line[x__] -> {CapForm["Butt"], Tube[Line[x], .02]};

line2new = 
  Graphics3D[N[First@line2] /. {x_?AtomQ, y_?AtomQ} -> {x, y, 1.}] /. 
   Line[x__] -> {CapForm["Butt"], Tube[Line[x], .1]};

overlapping1 = Show[{line2new, line1new}]

show 3D tubes

So the lines first of all are offset vertically. This is done so that the next step, the projection, will layer the thin blue line on top of the red one (which is closer to the bottom plane).

Now I create the planar plot as you did - but separately. Then I combine it with the projection result:

cpl3d = Graphics3D[N@First@cpl /. {x_?AtomQ, y_?AtomQ} -> {x, y, 0}];

Show[
 project[
  overlapping1, {0, 0, -1}, {0, 0, 1},
  "DarkShadow" -> False, "ObjectCenter" -> {0, 0, 1}],
 cpl3d
 ]

projection

The result seems to have no visual problems.

To explain how project works: the first argument is the Graphics3D (in this case overlapping1 corresponding to the two tubular lines). The second argument is the direction in which I want the shadow of this object to be projected. The third argument normal is the surface normal of the surface onto which we imagine projecting the object. The amount by which the object is translated is given by the length of the vector direction.

The projection involves a "flattening step" in which the center of mass of the object is moved into a plane including the origin, and in that step we lose the information where the object was originally. The translation by direction is applied starting from the origin.

That's fine if the center of the object was originally near the origin anyway, but in our overlapping1 object the center is somewhere higher up. I actually want the lowest of the lines to end up on the plane at z = 0, but the red line as at z = 1. To make this come out right, I have to provide the information that the original position of the object should be taken as z = 1, so that after the "flattening step" this original position is first restored before applying the translation in the projection direction {0, 0, -1}.

The original position is provided as an option "ObjectCenter". Another option is "DarkShadow" which by default is True, making shadows appear black or gray. In our case we want colored shadows, so I set this option to False.

I'll also have to update this code in the earlier answer linked above, because there I didn't catch an error that appears when projecting straight along the surface normal (since for such cases the function project is actually overkill, as I mentioned)... However, with this function you can then also project lines (or rather Tubes) onto arbitrary oblique surfaces, if desired.

Edit 2: Texture approach

The ultimate goal seems to involve further 3D manipulations, which may lead to unacceptably large files and sluggish response due to high polygon count (not just with my method above - it depends mainly on the number of polygons in the ContourPlot, which is usually rather large).

So I would suggest instead to go with the alternative approach that was already alluded to in the question: make the 2D graphics into a textured polygon. As it happens, I also had previously written a function for that.

It's called label3D and takes a any arbitrary input as its first argument, converts it into an Image and then puts it as a texture onto a rectangular Polygon whose dimensions are given by the arguments pos, xVec, tiltAngle in the code below. Here, pos is the location of the bottom left corner of the flattened polygon in 3D space. xVec is a vector pointing in the direction along which the baseline of the image should be oriented. The length of this vector is taken as the width of the polygon in 3D space. tiltAngle is the angle (in radians) by which the label is rotated around its baseline.

label3D[s_, pos_, xVec_, tiltAngle_, opts : OptionsPattern[]] := 
  Module[{ra, width, height, r}, 
   ra = Rasterize[
     Style[HoldForm[s], FilterRules[{opts}, Options[Style]], 
      Magnification -> 10], 
     Evaluate@
      Apply[Sequence, FilterRules[{opts}, Options[Rasterize]]], 
     "Image"];
   {width, height} = ImageDimensions[ra];
   r = SetAlphaChannel[ra, 
     With[{color = 
        Apply[List, 
         ColorConvert[
          "TransparentColor" /. {opts} /. {"TransparentColor" -> 
             Apply[RGBColor, ImageData[ra][[2, 2]]]}, "RGB"]]}, 
      Binarize[ra, (Norm[# - color] > .005) &]]];
   Translate[(* //to make lefthand corner pos*)
    Rotate[(*   //around z axis*)
     Rotate[(* //around y axis*)
      Rotate[(* //tilt around x axis*)
       Scale[(*//to make width equal|
        xVec|*){EdgeForm[FrameStyle /. {opts} /. FrameStyle -> None], 
         Texture[ImageData@r],(* //
         Texture fills polygon initially in the xz plane*)
         Polygon[{{0, 0, 0}, {width, 0, 0}, {width, 0, height}, {0, 0,
             height}}, 
          VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 
             1}}]}, Norm[xVec]/width, {0, 0, 0}], 
       tiltAngle, {1, 0, 0}],(* //x rotation*)
      Arg[Chop@N[Norm[xVec[[1 ;; 2]] + I xVec[[3]]]]], {0, -1, 
       0}],(* //y rotation*)
     Arg[Chop@N[xVec[[1]] + I xVec[[2]]]], {0, 0, 1}],(* //z rotation*)
    pos]];

The function recognizes the additional options Magnification (and also ImageSize) to determine the resolution of the rasterized image.

But in this application I chose to instead specify a fixed ImageSize for the original 2D plot, to make sure the line thicknesses are correct relative to the image size.

Here is the application to your problem. The 2D plot is made without tick marks and with no PlotRangePadding so that it fits snugly into the polygon of dimension $8\times 8$ in the 3D plot.

Although the rasterization step may take a second or two, the result is a smaller 3D graphics object that can be rotated more smoothly:

ClearAll[line1, line2, overlapping1, ov1Flat]
line1 = Graphics[{Thickness[0.003], Blue, Line[{{0, 0}, {4, 1}}]}];
line2 = Graphics[{Thickness[0.03], Red, Line[{{0, 0}, {4, 1}}]}];
overlapping1 = Show[{line2, line1}];

ov1Flat = 
  Show[{ContourPlot[Sin[y x], {x, -4, 4}, {y, -4, 4}], overlapping1}, 
   ImageSize -> 360, PlotRangePadding -> 0, FrameTicks -> None];

g = Graphics3D[
   label3D[ov1Flat, {-4, -4, 0}, {8, 0, 0}, -Pi/2]];

Show[
 {
  Plot3D[8 + Sin[y x], {x, -4, 4}, {y, -4, 4}, 
   MeshFunctions -> {(0.25 #1 - #2) &}, Mesh -> {{0}}, 
   MeshStyle -> {Blue, Thick}, PlotPoints -> 80],
  g
  },
 PlotRange -> All, BoxRatios -> {Automatic, Automatic, 6}]

label3D

share|improve this answer
    
this looks somewhat more promising (+1) but I have still to understand whether it can be done a little more automatically. Say I have a 2D plot with 20 lines, some overlapping, it seems I still have to go over each line and add the offsets so the projection does the job correctly. –  gpap Aug 15 '13 at 18:54
    
Ok, I get that. I don't really want to do manipulations in 3D but rather I want to export the 3D plot in decent quality. My workflow so far was to combine whatever projections I needed into one Graphics3D object and export the final result (without displaying it) to PDF forcing rasterization at the very end by using a transparent prolog (your method). –  gpap Aug 16 '13 at 9:25
add comment

Here is my try at it. I apologize for using the Presentations Application (and John Browne's GrassmannAlgebra package also) but it makes it easy for me. First I used GrassmannAlgebra to obtain an expression for the perpendicular lines to a given line with start and end points. (I suppose it's basic geometry but I need a computer!)

RectangleLine[start_, end_, width_] :=
 Module[{x0, x1, y0, y1, p1, p2, p3, p4, halfperpendicular},
  {x0, y0} = start;
  {x1, y1} = end;
  halfperpendicular = {(width (y0 - y1))/(
    2 Sqrt[(x0 - x1)^2 + (y0 - y1)^2]), (width (-x0 + x1))/(
    2 Sqrt[(x0 - x1)^2 + (y0 - y1)^2])};
  p1 = start - halfperpendicular;
  p2 = start + halfperpendicular;
  p3 = end + halfperpendicular;
  p4 = end - halfperpendicular;
  Polygon[{p1, p2, p3, p4}]
  ]

Here is an example of a thick and thin line.

<< Presentations`

Draw2D[
 {{EdgeForm[Black], FaceForm[Red], 
   RectangleLine[{0, 0}, {4, -4}, 0.2]},
  {EdgeForm[Black], FaceForm[Black], 
   RectangleLine[{0, 0}, {4, -4}, 0.03]}},
 Frame -> True,
 ImageSize -> 250]

enter image description here

The following draws the lines on top of a contour plot. I save the contour primitives and line primitives separately. One of the problems that you may have is contrast between the lines and the contour plot. I used pastel colors for the contour plot so the lines will better stand out.

Draw2D[
 {contourDraw =
   ContourDraw[Sin[y x], {x, -4, 4}, {y, -4, 4}, Contours -> 5, 
    ColorFunction -> ColorData["Pastel"]],
  plotLines = {{EdgeForm[Black], FaceForm[Red], 
     RectangleLine[-{4, 1}, {4, 1}, 0.4]},
    {EdgeForm[Black], FaceForm[Black], 
     RectangleLine[-{4, 1}, {4, 1}, 0.03]}}},
 Frame -> True,
 ImageSize -> 250]

enter image description here

Finally, here is the 3D plot. NeutralLighting generates a set of Lighting options often similar to Lighting -> "Neutral", but with much more control. We can control the amount of light that comes from the directional lights and the amount that comes from ambient light. For the curved surface we want more directional light to give shading to the surface. For the contour plot and lines we want more ambient light. One of the very nice features of Mathematica graphics is that one can intersperse lighting options with graphics primitives and that is what I have done here. Another feature I used here was fewer PlotPoints and increased MaxRecursion. This is generally more efficient. Notice that I did raise the lines above the surface. You just have to do it.

Draw3DItems[
 {NeutralLighting[0, 0.6, 0.2],
  Draw3D[8 + Sin[y x], {x, -4, 4}, {y, -4, 4}, 
   MeshFunctions -> {(0.25 #1 - #2) &}, Mesh -> {{0}}, 
   MeshStyle -> {Blue, Thick}, PlotPoints -> 20, MaxRecursion -> 3, 
   PlotStyle -> Orange],
  NeutralLighting[0, 0.3, 0.6],
  contourDraw // RaiseTo3D[0 &],
  plotLines // RaiseTo3D[0.1 &]},
 NiceRotation,
 Axes -> True,
 AxesLabel -> {"x", "y", "z"},
 ImageSize -> 300]

enter image description here

I don't know enough about your final objective but there are many ways to present information. Often multiple images are clearer than cramming too much into a single image.

share|improve this answer
3  
Please add your customary "which I sell" part. Thanks –  belisarius Aug 16 '13 at 3:01
    
@ Belisarius As long as those who are asking questions whose results will be used in their remunerated work, or in their schoolwork are also asked to state this fact. And the fact that these applications are sold is clearly stated on my profile page. –  David Park Aug 16 '13 at 3:23
2  
I really appreciate your answers and products, and I would like you to continue answering and abide by the site policies at the same time. –  belisarius Aug 16 '13 at 3:53
    
@ Belisarius I think it is discriminatory and puts me as a second class citizen. Does every answer state that one must purchase Stephen Wolfram's expensive application? I don't answer many questions but when I do I think the answers are simple and high quality. I don't make peanuts from it. It takes time so perhaps I have better things to do. –  David Park Aug 16 '13 at 4:07
    
My intention is not to discriminate you in any way, and I fully agree about the quality of your answers. But these sites have been evolving for a few years now and like in any long standing community there are a few behavioral rules and policies already established (and not all of them fit me either). I think you may post a question on meta about what other users think about this issue and then decide what to do with your time. Also, please consider that writing a standard disclaimer, perhaps at the end of your posts isn't that hard. –  belisarius Aug 16 '13 at 4:28
show 2 more comments

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.