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

RE: GraphicsArray: same width, different height ? 360deg-fly around a surface

• To: mathgroup at smc.vnet.net
• Subject: [mg35647] RE: [mg35611] GraphicsArray: same width, different height ? 360deg-fly around a surface
• From: "David Park" <djmp at earthlink.net>
• Date: Wed, 24 Jul 2002 02:06:14 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

Stef,

If you want to install the DrawGraphics package from my web site, then the
attached notebook shows a good method for making the plot and animation.

GraphicsArray, or putting plots in two rectangles, is very difficult.
Mathematica does not give easy or accurate control of the plot region and
overall aspect.

Instead, I plot the two surfaces in one plot, giving the top surface an
offset. I also give the two surfaces different colors and use neutral
lighting so they will show better.

Anyone interested in the notebook with the example can contact me.

David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/

-----Original Message-----
From: stef [mailto:stefaniekuschel at gmx.de]
To: mathgroup at smc.vnet.net


 Dear experts,

 How can I force mathemathica41 to make graphics in a column of same
 width but different height?
 By default, mathematica gives two cells on top of each other the same
 height, but arranges the width such that both cells fit in the column
 width.
 This results in a horizontal sequeezing/scaling of cells which I would
 like to omit.

 Here is an example:
 Single output of both plots one after to the other just looks fine,
 but when they enter in an GraphicsArray[], the automatic scaling
 squeezes the lower cell width instead of stretching its height.


 >>>> demo start : just cut and paste into a new .nb >>>>>>>>>>

 \!\(\(\( (*\
 demo\ starts\ here\ *) \)\(\[IndentingNewLine]\)\(\("\<two single
 plots \
 are shown here:\>"\)\(\[IndentingNewLine]\)
 \(table1\ 
 ListPlot3D[
 Table[Sin[x\ y], {x, 0, \(3 Pi\)\/2, Pi\/15}, {y, 0, \(3
 Pi\)\/2,
 Pi\/15}], \ PlotRange\ -> {0, \ 0.25},
 Axes\ -> \ {None, \ None, \ None}, \
 ViewPoint\ -> \ \ {5, \(-2.5\), 0.6},
 BoxRatios\ -> \ {10, 10, 1.25}];\)\(\[IndentingNewLine]\)
 \(table2\ = \
 ListPlot3D[
 Table[Sin[x\ y], {x, 0, \(3 Pi\)\/2, Pi\/15}, {y, 0, \(3
 Pi\)\/2,
 Pi\/15}], \ PlotRange\ -> {\(-1\), \ 0}, \
 Axes\ -> \ {None, \ None, \ None},
 ViewPoint\ -> \ {5, \(-2.5\), 1},
 BoxRatios\ -> \ {10, 10, 5}];\)\(\[IndentingNewLine]\)
 \("\<and this is how they look whend combined into an
 graphicsarray:\>"\)\(\
 \[IndentingNewLine]\)
 \(table3\ = {{table1}, {table2}};\)\(\[IndentingNewLine]\)
 \(Show[GraphicsArray[
 table3, \ \ GraphicsSpacing\ -> \
 0]];\)\(\[IndentingNewLine]\)
 \("\<My question is: how to make cells in an graphics array to same
 width \
 (but different height) ? Mathematicas default is: same height, but
 different \
 widths.\>"\)\(\[IndentingNewLine]\)
 \( (*\ demo\ ends\ here*) \)\)\)\)

 >>>> demo end >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

 Playing around with TableForm[] or RowsEqual-> or ImageSize-> didn't
 help so far. For all those of you that might have similar problems
 with plotting graphics:
 there are good support-procedures on the David-Park-homepage
 http://home.earthlink.net/~djmp/Mathematica.html
 But I couldn't find a solution for my problem.


 My general purpose is to generate an animated GIF, which shows a
 360-degree-fly-around a surface plot, that is cut into two parts
 at some z-value (this visualizes threshold effects on surfaces).
 Interested people can get a copy of my *.nb

 I carefully browsed through TMB and F1HELP for GraphicsArray-Options
 (well I think that F1 is pretty poor on these specific subjects),
 and of course also this newsgroup, but I couln't find the magic trick
 sought for.

 Thanks for your help in advance

 Bye
 Stef


(************** Content-type: application/mathematica **************

                    Mathematica-Compatible Notebook

This notebook can be used with any Mathematica-compatible
application, such as Mathematica, MathReader or Publicon. The data
for the notebook starts with the line containing stars above.

To get the notebook into a Mathematica-compatible application, do
one of the following:

* Save the data starting with the line of stars above into a file
  with a name ending in .nb, then open the file inside the
  application;

* Copy the data starting with the line of stars above to the
  clipboard, then use the Paste menu command inside the application.

Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode.  Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).

NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing
the word CacheID, otherwise Mathematica-compatible applications may
try to use invalid cache data.

For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
  web: http://www.wolfram.com
  email: info at wolfram.com
  phone: +1-217-398-0700 (U.S.)

Notebook reader applications are available free of charge from
Wolfram Research.
*******************************************************************)

(*CacheID: 232*)


(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[      8180,        207]*)
(*NotebookOutlinePosition[      8823,        229]*)
(*  CellTagsIndexPosition[      8779,        225]*)
(*WindowFrame->Normal*)



Notebook[{

Cell[CellGroupData[{
Cell["Exploration (Skip)", "Section"],

Cell[BoxData[{
    \( (*\ demo\ starts\ here\ *) \[IndentingNewLine]"\<two single
 plots  are shown here:\>"\), "\[IndentingNewLine]",
    \(\(table1\  
        ListPlot3D[
          Table[Sin[x\ y], {x, 0, \(3  Pi\)\/2, Pi\/15}, {y, 0, \(3  
Pi\)\/2,
              Pi\/15}], \ PlotRange\  -> {0, \ 0.25},
          Axes\  -> \ {None, \ None, \ None}, \
          ViewPoint\  -> \ \ {5, \(-2.5\), 0.6},
          BoxRatios\  -> \ {10, 10, 1.25}];\)\), "\[IndentingNewLine]",
    \(\(table2\  = \
        ListPlot3D[
          Table[Sin[x\ y], {x, 0, \(3  Pi\)\/2, Pi\/15}, {y, 0, \(3  
Pi\)\/2,
              Pi\/15}], \ PlotRange\  -> {\(-1\), \ 0}, \
          Axes\  -> \ {None, \ None, \ None},
          ViewPoint\  -> \ {5, \(-2.5\), 1},
          BoxRatios\  -> \ {10, 10, 5}];\)\), "\[IndentingNewLine]",
    \("\<and this is how they look whend combined into an
 graphicsarray:\>"\), "\[IndentingNewLine]",
    \(\(table3\  = {{table1}, {table2}};\)\), "\[IndentingNewLine]",
    \(\(Show[
        GraphicsArray[
          table3, \ \ GraphicsSpacing\  -> \.010]];\)\), \
"\[IndentingNewLine]",
    \("\<My question is: how to make cells in an graphics array to same
 width  (but different height) ? Mathematicas default is: same height, 
but
 different  widths.\>"\), "\[IndentingNewLine]",
    \( (*\ demo\ ends\ here*) \)}], "Input"],

Cell[BoxData[
    \(\(table1\  
        ListPlot3D[
          Table[Sin[x\ y], {x, 0, \(3  Pi\)\/2, Pi\/15}, {y, 0, \(3  
Pi\)\/2,
              Pi\/15}], \ PlotRange\  -> {0, \ 0.25},
          Axes\  -> \ {None, \ None, \ None}, \
          ViewPoint\  -> \ \ {5, \(-2.5\), 0.6},
          BoxRatios\  -> \ {10, 10,
              1.25}, \[IndentingNewLine]AspectRatio \[Rule]
            0.25];\)\)], "Input"],

Cell[BoxData[
    \(\(table2\  = \
        ListPlot3D[
          Table[Sin[x\ y], {x, 0, \(3  Pi\)\/2, Pi\/15}, {y, 0, \(3  
Pi\)\/2,
              Pi\/15}], \ PlotRange\  -> {\(-1\), \ 0}, \
          Axes\  -> \ {None, \ None, \ None},
          ViewPoint\  -> \ {5, \(-2.5\), 1},
          BoxRatios\  -> \ {10, 10, 5}];\)\)], "Input"],

Cell[BoxData[{
    \(\(table3\  = {{table1}, {table2}};\)\), "\[IndentingNewLine]",
    \(\(Show[
        GraphicsArray[table3, \ \ GraphicsSpacing\  -> 0]];\)\)}], 
"Input"],

Cell[CellGroupData[{

Cell[BoxData[
    \(Show[
      Graphics[\[IndentingNewLine]{Rectangle[{1, 1}, \ {11, 5},
            table1], \[IndentingNewLine]Rectangle[{1, 6}, \ {11, 7},
            table2]}], \[IndentingNewLine]AspectRatio \[Rule]
        Automatic, \[IndentingNewLine]PlotRange \[Rule]
        All, \[IndentingNewLine]Frame \[Rule]
        True, \[IndentingNewLine]ImageSize \[Rule] 400]\)], "Input"],

Cell[BoxData[
    TagBox[\(\[SkeletonIndicator]  Graphics  \[SkeletonIndicator]\),
      False,
      Editable->False]], "Output"]
}, Open  ]]
}, Closed]],

Cell[CellGroupData[{

Cell["Using DrawGraphics", "Section"],

Cell["You need this package from my web site.", "Text"],

Cell[BoxData[
    \(Needs["\<DrawGraphics`DrawingMaster`\>"]\)], "Input"],

Cell["\<\
This is our sample function. If you are working from data, you might 
want to \
make an InterpolatingFunction.\
\>", "Text"],

Cell[BoxData[
    \(\(f[x_, y_] := Sin[x\ y];\)\)], "Input"],

Cell[TextData[{
  "Trying to use a graphic array, or to place the plots in two 
rectangles, is \
very difficult because ",
  StyleBox["Mathematica",
    FontSlant->"Italic"],
  " does not give us sure or easy control of the aspect ratio and plot \
region. Instead, I plot two surfaces with a min value, split value and 
max \
value. I parametrize the top and bottom surfaces and use a parametric 
plot. I \
give each surface a different color. I also give the polygon edges a 
subdued \
color which is part way between the surface color and black.  I give the 
top \
surface an offset. NeutralLighting is a DrawGraphics routine that 
inserts \
Lighting options. It controls the saturation, brightness and ambient \
lighting, and you can also rotate the lights if you wish. The surface 
colors \
show much better if the lighting has low color saturation."
}], "Text"],

Cell["This makes the basic plot.", "Text"],

Cell[BoxData[
    \(\(plot1 = \[IndentingNewLine]Module[\[IndentingNewLine]{min  
\(-1\), \
\[IndentingNewLine]zsplit = 0, \[IndentingNewLine]max 
              0.25, \[IndentingNewLine]offset 
              0.25, \[IndentingNewLine]bottom, top, x,
            y}, \[IndentingNewLine]bottom = {x, y,
              Max[min, Min[zsplit, f[x, y]]]}; \[IndentingNewLine]top 
= {x,
              y, Max[zsplit, Min[max, f[x, y]]] +
                offset}; 
\[IndentingNewLine]\[IndentingNewLine]Draw3DItems[\
\[IndentingNewLine]{SurfaceColor[SkyBlue],
              EdgeForm[\(ColorMix[SkyBlue, Black]\)[
                  0.5]], \[IndentingNewLine]ParametricDraw3D[
                top // Evaluate, {x, 0, \(3  Pi\)\/2}, {y, 0, \(3  
Pi\)\/2},
                PlotPoints \[Rule] 50], \[IndentingNewLine]SurfaceColor[
                Salmon],
              EdgeForm[\(ColorMix[Salmon, Black]\)[
                  0.5]], \[IndentingNewLine]ParametricDraw3D[
                bottom // Evaluate, {x, 0, \(3  Pi\)\/2}, {y,
                  0, \(3  Pi\)\/2},
                PlotPoints \[Rule]
                  50]}, \[IndentingNewLine]ViewPoint -> {1.783, \ 
\(-2.851\), \
\ 0.379}, \[IndentingNewLine]NeutralLighting[0.3, 0.5,
              0.1], \[IndentingNewLine]Boxed \[Rule]
              False, \[IndentingNewLine]SphericalRegion \[Rule]
              True, \[IndentingNewLine]ImageSize \[Rule]
              500\[IndentingNewLine]]\[IndentingNewLine]];\)\)], 
"Input"],

Cell["\<\
This spins the plot around. Notice that the viewpoint in SpinShow is \
unrelated to the viewpoint used  in the basic plot.\
\>", "Text"],

Cell[BoxData[{
    \(SpinShow[plot1, SpinOrigin \[Rule] {0, 0, 0.5},
      SpinDistance \[Rule] 10]\), "\[IndentingNewLine]",
    \(SelectionMove[EvaluationNotebook[], All, GeneratedCell]\), "\n",
    \(FrontEndTokenExecute["\<OpenCloseGroup\>"]\), "\n",
    \(FrontEndTokenExecute["\<SelectionAnimate\>"]\)}], "Input"],

Cell["\<\
You could also write the plot as a routine with parameters and an angle. 
Use \
DrawingTransform3D to rotate the surfaces. You could then generate the \
individual frames in a table. This might be easier for generating the 
gif.\
\>", "Text"]
}, Open  ]]
},
FrontEndVersion->"4.1 for Microsoft Windows",
ScreenRectangle->{{0, 1280}, {0, 943}},
WindowSize->{625, 729},
WindowMargins->{{0, Automatic}, {Automatic, 0}}
]

(*******************************************************************
Cached data follows.  If you edit this Notebook file directly, not
using Mathematica, you must remove the line containing CacheID at
the top of  the file.  The cache data will then be recreated when
you save this file from within Mathematica.
*******************************************************************)

(*CellTagsOutline
CellTagsIndex->{}
*)

(*CellTagsIndex
CellTagsIndex->{}
*)

(*NotebookFileOutline
Notebook[{

Cell[CellGroupData[{
Cell[1727, 52, 37, 0, 59, "Section"],
Cell[1767, 54, 1360, 27, 400, "Input"],
Cell[3130, 83, 418, 9, 104, "Input"],
Cell[3551, 94, 342, 7, 84, "Input"],
Cell[3896, 103, 174, 3, 50, "Input"],

Cell[CellGroupData[{
Cell[4095, 110, 396, 7, 150, "Input"],
Cell[4494, 119, 130, 3, 29, "Output"]
}, Open  ]]
}, Closed]],

Cell[CellGroupData[{
Cell[4673, 128, 37, 0, 39, "Section"],
Cell[4713, 130, 55, 0, 33, "Text"],
Cell[4771, 132, 73, 1, 30, "Input"],
Cell[4847, 135, 133, 3, 33, "Text"],
Cell[4983, 140, 60, 1, 30, "Input"],
Cell[5046, 143, 859, 14, 147, "Text"],
Cell[5908, 159, 42, 0, 33, "Text"],
Cell[5953, 161, 1483, 25, 525, "Input"],
Cell[7439, 188, 146, 3, 52, "Text"],
Cell[7588, 193, 323, 5, 90, "Input"],
Cell[7914, 200, 250, 4, 52, "Text"]
}, Open  ]]
}
]
*)



(*******************************************************************
End of Mathematica Notebook file.
*******************************************************************)