Graphics Programming

Tom Wickham-Jones

Wolfram Research

Function Plotting

wierdf[x_] := If[ x > -1 && x < 1, x^2, Exp[ 1- x^2]]

Plot[ wierdf[t], {t,-3,3}]

NDSolve[ {x''[t] == -x[t],
          x[0] == 2,
          x'[0] == 0}, x, {t,0,20}]

Plot[ Evaluate[ x[t] /. %], {t,0,20}]

NDSolve[ {x''[t] == -x[t] -x[t] y[t]^2,
          y''[t] == -y[t] -x[t] y[t]^2,
          x[0] == 2, x'[0] == 0,
          y[0] == 1, y'[0] == 0 },
          {x, y}, {t,0,15}]

ParametricPlot[ Evaluate[ {x[t], y[t]} /. First[%]],
                                          {t,0,15}]

Animation

Only on some Front Ends

Do[ Plot[ Sin[ n x], {x,0,2Pi}], {n,5}]

Table[ Plot[ Sin[ n x], {x,0,2Pi}],
               {n,5}]

Table[ Show[ Graphics[{
	   RGBColor[ 1,0,0],
       Polygon[n {{-1,-1}, {1,-1}, {1,1},{-1,1}}]}]], {n,5}]

Table[ Show[ Graphics[{
	   RGBColor[ 1,0,0],
       Polygon[n {{-1,-1}, {1,-1}, {1,1},{-1,1}}]},
       PlotRange -> {{-5,5}, {-5,5}}]], {n,5}]

SphericalRegion

Color

Color Directives

Show[ Graphics[{Hue[.5], 
                Polygon[{{0,0}, {1,0}, {0,1}}]}]]

Show[ Graphics[ {CMYKColor[ 1,0,0,0],
                Polygon[{{0,0}, {1,0}, {0,1}}]}]]

Show[ Graphics3D[ {SurfaceColor[ RGBColor[1,0,0]],
					Polygon[{{0,0,0}, {0,1,0},{1,0,0}}]},
					ViewPoint -> {0,0,2},
					LightSources ->
					 {{{0,0,1}, RGBColor[1,1,1]}}]]

Color Coordinate

Plot3D[ {Tan[x y], Hue[ ArcTan[x,y] /2/Pi]},
               {x,-2Pi/3, 2Pi/3},{y,-2Pi/3, 2Pi/3}]

ParametricPlot3D[ {Cos[p] Sin[t], Sin[p] Sin[t], Cos[t],
                   FaceForm[ Hue[(t+p)/Pi]]},
                   {p,0,2Pi}, {t,0,Pi},
                   Lighting -> False]

ColorFunction

Plot3D[ x y, {x,-2,2}, {y,-2,2}, ColorFunction -> Hue]

col[z_] := Hue[ x^0.65]

ContourPlot[ Evaluate[
				Sum[ Sin[ n x m y], {n,5}, {m,5}]],
			{x,0,2Pi}, {y,0,2Pi}, ColorFunction -> Hue]

ColorOutput

plot = Show[ Graphics[ {RGBColor[ 1,0,0],
                 Rectangle[{0,0}, {1,1}]},
                 ColorOutput -> CMYKColor]]

colfun[ RGBColor[ r_, g_, b_]] :=
		RGBColor[ 1-r, 1-g, 1-b]

colfun[ GrayLevel[ g_]] := GrayLevel[g]

Show[ plot, ColorOutput -> colfun]

Converting and Combining Images

Plot[ Evaluate[ Table[ x^n, {n,5}]], {x,0,1.2}]

ParametricPlot3D[ Evaluate[
					Table[{ Cos[x], Sin[x], n x},
										{n,5}]],
					{x,0,2Pi}, BoxRatios -> {1,1,1}]

plot = Plot3D[ x^2 - y^2, {x,-1,1}, {y,-1,1},
		BoxRatios -> {1,1,2}]

Show[ Graphics3D[ plot]]

plot1 = Plot3D[ y^2 - x^2, {x,-1,1}, {y,-1,1},
		BoxRatios -> {1,1,2}]

Show[ plot1, plot]

Show[ ContourGraphics[ plot]]

Show[ Graphics[ plot1]]

Mathematica Graphics Coordinate Systems I

PlotRange

plot = Plot[ Tan[x], {x,0,2Pi}]

FullOptions[ %, PlotRange]

Show[ plot, PlotRange -> All]

FullOptions[%, PlotRange]

AspectRatio

Show[ Graphics[ Rectangle[ {0,0}, {4,1}]]]

Show[ %, AspectRatio -> 1]

Show[%, AspectRatio -> Automatic]

Care !!!!!!!!

Plot[ Tan[x], {x,0,2Pi}, AspectRatio -> Automatic]

lrect[ {x0_, y0_}, {x1_, y1_}] :=
	Line[{{x0, y0}, {x1, y0}, {x1, y1},
			{x0,y1}, {x0,y0}}]

arrow[ y_, {x0_, x1_}] :=
	Module[{ len = (x1-x0)/4, xp, yp},
		xp = x1 - len ;
		yp = len Tan[ Pi/4] ;
		{AbsoluteThickness[ 0.75],
		 Line[ {{xp, y+yp},
		        {x1, y},
		        {xp, y-yp}}],
		 AbsoluteThickness[1.0],
		 Line[{{x0, y}, {x1, y}}]}
 	]

Show[ Graphics[{
		Text[ {xmin, ymin}, {0,0}, {0,1.4}],
		Text[ {xmax, ymax}, {1,1}, {0,-1.4}],
		lrect[ {0,0}, {1,1}],
		Text[ {0, 0}, {2.5,0}, {0,1.4}],
		Text[ {1, AR}, {3.5,1}, {0,-1.4}],
		lrect[ {2.5, 0}, {3.5,1}],
		arrow[ 0.5, {1.375, 2.125}]},
		AspectRatio -> Automatic,
		PlotRange -> All]]

Show[ Graphics[{
		PostScript["0.008 setlinewidth"],
		PostScript[" .1 .1 moveto"],
		PostScript[" .7 .9 .4 .3 .9 .1 curveto"],
		PostScript[" stroke"]},
		Frame -> True,
		PlotRange -> {{0,1}, {0,0.061804}}]]

The Coordinate Area

Show[ Graphics[ {
		PointSize[ 0.02],
		Point[{5,10}]},
		PlotRange -> {{0,10}, {0,20}},
		Frame -> True]]

Show[ Graphics[{
	Line[{{0,0}, {1,1}}],
	Text["This is a rather long string", {2,2}]}]]

Show[ Graphics[{
	Line[{{0,0}, {1,1}}],
	Text["This is a rather long string", {2,2}, {1,1}]}]]

Show[ Graphics[{
	Line[{{0,0}, {1,1}}],
	Text["This is a rather long string", {2,2}]},
	PlotRange -> All]]

PlotRegion

DensityPlot[ Sin[x y],
				{x,0,2Pi},
				{y,0,2Pi},
				PlotRegion -> {{0.25, 0.75},
				               {0.25, 0.75}}]

Mathematica Graphics Coordinate Systems II

BoxRatios

Show[ Graphics3D[
		Cuboid[{0,0,0}, {1,2,5}],
		BoxRatios -> {1,1,1}]]

Show[%, BoxRatios -> Automatic]

Projection

Show[ Graphics3D[{
	PointSize[.04],
	Text["Projection\n  Point",
	            {-.2,-.5,-.5},{-.6,0}],
	Point[{0,0,0}],
	Text["Projection\n  Plane",
	            {-1, 2.1, 2.1},{1,-1}],
	Polygon[{{-1,2,2}, {-1,-2,2},
	             {-1,-2,-2}, {-1,2,-2}}],
	Thickness[0.01],
	Line[{{-1, -.5, -.5}, {-1, .5, .5}}],
	Line[{{-3, -1.5, -1.5}, {-4, 2,2}}],
	Thickness[.001], 
	Line[{{-3, -1.5, -1.5}, {0,0,0},{-4, 2,2}}]},
	Boxed -> False]]

<<Graphics`Polyhedra`

Show[ Graphics3D[ Stellate[ Icosahedron[]]]]

FullOptions[ %, ViewPoint]

Show[%%, ViewPoint -> % / 2.3999]

Plot3D[ x y, {x,0,2}, {y,0,2}]

Show[%, ViewVertical -> {0,1,0}]