(*
Simplex`SimplexDrawGraphics` Package
*)
(*
Carl T. Bergstrom 
Department of Biology
University of Washington
Seattle, WA 98115
cbergst@u.washington.edu
*)
(*
Implementation
*)
(*
Begin Package
*)
BeginPackage["Simplex`SimplexDrawGraphics`", {"DrawGraphics`DrawingPaper`", 
    "DrawGraphics`DrawingField`", "DrawGraphics`DrawingCube`", 
    "Simplex`SimplexBasics`"}]
(*
"Simplex`SimplexDrawGraphics`"
*)
Simplex`SimplexBasics::usage = "The Simplex`SimplexDrawGraphics` package \
provides a set of graphics routines extending David Park's DrawGraphics \
package to the 2-D simplex."
(*
"The Simplex`SimplexDrawGraphics` package provides a set of graphics routines \
extending David Park's DrawGraphics package to the 2-D simplex."
*)
(*
Usage Messages
*)
(*
SimplexBoundary
*)
SimplexBoundary::usage = "SimplexBoundary creates the graphics
primitives to produce the outline of the 2D simplex using
DrawGraphics.

To call the routine, use Draw2d[{SimplexBoundary},{}]"


(*
"SimplexBoundary creates the graphics primitives to produce the outline of \
the 2D simplex using DrawGraphics.  To call the routine, use \
Draw2d[{SimplexBoundary},{}]"
*)
(*
SimplexPicture
*)

SimplexPicture::usage = "SimplexPicture[components__,opts___?OptionQ] uses \
the
DrawGraphics routines to draw a 2D simplex with the components listed.

Example: SimplexPicture[SimplexParametricDraw[f],SimplexBoundary];"
(*
"SimplexPicture[components__,opts___?OptionQ] uses the DrawGraphics routines \
to draw a 2D simplex with the components listed.  Example: \
SimplexPicture[SimplexParametricDraw[f],SimplexBoundary];"
*)
(*
SimplexContourPicture
*)
SimplexContourPicture::usage = \
"SimplexContourPicture[func_,contours_,opts___?OptionQ]
uses the DrawGraphics routines to draw a contour plot on the 2D
simplex. This is just a shorthand for SimplexContourDraw, to display
the image, get the aspect ratio right, and put the boundary in
place. The function func is of the form func[{x,y,z}], and contours is
a list of contours to be used with the ContourColors routine."

(*
"SimplexContourPicture[func_,contours_,opts___?OptionQ] uses the DrawGraphics \
routines to draw a contour plot on the 2D simplex. This is just a shorthand \
for SimplexContourDraw, to display the image, get the aspect ratio right, and \
put the boundary in place. The function func is of the form func[{x,y,z}], \
and contours is a list of contours to be used with the ContourColors \
routine."
*)
(*
SimplexParametrixDraw
*)
SimplexParametricDraw::usage = "SimplexParametricDraw[func_]
creates the graphics primitives to be used by the DrawGraphics
package in order to produce a parametric plot of function func on the
two-dimensional simplex. The function in question should be of the
form func[x_]={f1[x],f2[x],f3[x]}. This function does not truncate
outside of the simplex. To call the routine, use
Draw2d[{SimplexParametrixDraw[]},{}]."
(*
"SimplexParametricDraw[func_] creates the graphics primitives to be used by \
the DrawGraphics package in order to produce a parametric plot of function \
func on the two-dimensional simplex. The function in question should be of \
the form func[x_]={f1[x],f2[x],f3[x]}. This function does not truncate \
outside of the simplex. To call the routine, use \
Draw2d[{SimplexParametrixDraw[]},{}]."
*)
(*
SimplixListDraw
*)
SimplexListDraw::usage = "SimplexListDraw[list_] creates a list
plot of the list list_ on the two-dimensional simplex. The list should
be of the form list={{x1,y1,z1},{x2,y2,z2},{x3,y3,z3},....}. The
function accepts options as usual,
e.g. SimplexListDraw[list,PlotJoined->True] joins the points of the
list."

(*
"SimplexListDraw[list_] creates a list plot of the list list_ on the \
two-dimensional simplex. The list should be of the form \
list={{x1,y1,z1},{x2,y2,z2},{x3,y3,z3},....}. The function accepts options as \
usual, e.g. SimplexListDraw[list,PlotJoined->True] joins the points of the \
list."
*)
(*
SimplexDrawVectorField
*)
SimplexDrawVectorField::usage = "SimplexDrawVectorField[v_] plots the vector
field defined by the function v[{x1_,x2_,x3_}] on the simplex. The vector \
field is restricted to the simplex proper."

(*
"SimplexDrawVectorField[v_] plots the vector field defined by the function \
v[{x1_,x2_,x3_}] on the simplex. The vector field is restricted to the \
simplex proper."
*)
(*
SimplexDraw3D
*)
SimplexDraw3D::usage = "SimplexDraw3D[func_,points__] plots
three-variable function func on the 2D simplex with a grid of points
triangles along each edge. The function func should be of the form
func[{x1_,x2_,x3_}]. "

(*
"SimplexDraw3D[func_,points__] plots three-variable function func on the 2D \
simplex with a grid of points triangles along each edge. The function func \
should be of the form func[{x1_,x2_,x3_}]. "
*)
(*
SimplexDraw3dColor
*)
SimplexDraw3dColor::usage = \
"SimplexDraw3dColor[func_,points_,colorfn___Function] behaves as does \
SimplexDraw3D, but the triangles are now colored according to colorfn, where \
colorfn is a function of the form func[{x1_,x2_,x3_}] that specifies a color, \
e.g. colorfn[{x1_,x2_,x3_}:=Hue[x1]."
(*
"SimplexDraw3dColor[func_,points_,colorfn___Function] behaves as does \
SimplexDraw3D, but the triangles are now colored according to colorfn, where \
colorfn is a function of the form func[{x1_,x2_,x3_}] that specifies a color, \
e.g. colorfn[{x1_,x2_,x3_}:=Hue[x1]."
*)
(*
SimplexDraw3dUp
*)
SimplexDraw3dUp::usage = "SimplexDraw3dUp[func_,points_] generates the
3D graphics primitives used to plot the function func:R3->R on the 2D
simplex using small triangles. The parameter points gives the number
of triangles along each side. This plots only the triangles facing up,
giving a sort of see-through simplex."
(*
"SimplexDraw3dUp[func_,points_] generates the 3D graphics primitives used to \
plot the function func:R3->R on the 2D simplex using small triangles. The \
parameter points gives the number of triangles along each side. This plots \
only the triangles facing up, giving a sort of see-through simplex."
*)
(*
SimplexDraw3dUpColor
*)
SimplexDraw3dUpColor::usage = \
"SimplexDraw3dUpColor[func_,points_,colorfn___Function] behaves as does \
SimplexDraw3dUp, but the triangles are now colored according to colorfn, \
where colorfn is a function of the form func[{x1_,x2_,x3_}] that specifies a \
color, e.g. colorfn[{x1_,x2_,x3_}:=Hue[x1]."
(*
"SimplexDraw3dUpColor[func_,points_,colorfn___Function] behaves as does \
SimplexDraw3dUp, but the triangles are now colored according to colorfn, \
where colorfn is a function of the form func[{x1_,x2_,x3_}] that specifies a \
color, e.g. colorfn[{x1_,x2_,x3_}:=Hue[x1]."
*)
(*
SimplexDraw3dDown
*)
SimplexDraw3dDown::usage = "SimplexDraw3dDown[func_,points_] generates
the 3D graphics primitives used to plot the function func:R3->R on the
2D simplex using small triangles. The parameter points gives the
number of triangles along each side. This plots only the triangles
facing down, giving a sort of see-through simplex."

(*
"SimplexDraw3dDown[func_,points_] generates the 3D graphics primitives used \
to plot the function func:R3->R on the 2D simplex using small triangles. The \
parameter points gives the number of triangles along each side. This plots \
only the triangles facing down, giving a sort of see-through simplex."
*)
(*
SimplexDraw3dDowmColor
*)
SimplexDraw3dDownColor::usage = \
"SimplexDraw3dUpColor[func_,points_,colorfn___Function] behaves as does \
SimplexDraw3dDown, but the triangles are now colored according to colorfn, \
where colorfn is a function of the form func[{x1_,x2_,x3_}] that specifies a \
color, e.g. colorfn[{x1_,x2_,x3_}:=Hue[x1]."
(*
"SimplexDraw3dUpColor[func_,points_,colorfn___Function] behaves as does \
SimplexDraw3dDown, but the triangles are now colored according to colorfn, \
where colorfn is a function of the form func[{x1_,x2_,x3_}] that specifies a \
color, e.g. colorfn[{x1_,x2_,x3_}:=Hue[x1]."
*)
(*
SimplexPolyGrid
*)
SimplexPolyGrid::usage = "SimplexPolyGrid[p_] is analogous to MakePolyGrid in \
DrawGraphics: it creates a lattice of triangular regions - p along each side \
- across the 2D simplex. Formally, each triangular region is actually a \
four-sided region, with one side of zero length, so as to be compatible with \
various DrawGraphics routines."
(*
"SimplexPolyGrid[p_] is analogous to MakePolyGrid in DrawGraphics: it creates \
a lattice of triangular regions - p along each side - across the 2D simplex. \
Formally, each triangular region is actually a four-sided region, with one \
side of zero length, so as to be compatible with various DrawGraphics \
routines."
*)
(*
SimplexContourDraw
*)
SimplexContourDraw::usage = "SimplexContourDraw[func_,contours_]
generates the graphics primitives for the contour plot of function
func[{x,y,z}] on the 2D simplex. The list contours is
a list of contours to be used with the ContourColors routine."

(*
"SimplexContourDraw[func_,contours_] generates the graphics primitives for \
the contour plot of function func[{x,y,z}] on the 2D simplex. The list \
contours is a list of contours to be used with the ContourColors routine."
*)
(*
Begin Private
*)
Begin["`Private`"]
(*
"Simplex`SimplexDrawGraphics`Private`"
*)
(*
Routines
*)
(*
SimplexBoundary
*)
SimplexBoundary := {Thickness[.008], 
    Line[{{0, 0}, {1/2, Sqrt[3]/2}, {1, 0}, {0, 0}}]}

(*
SimplexPicture
*)
SimplexPicture[components__, opts___?OptionQ] := 
  Draw2D[{components}, PlotRange -> {{0, 1}, {0, 1}}, opts, AspectRatio -> 1]
(*
SimplexContourPicture
*)
SimplexContourPicture[func_, contours_, opts___?OptionQ] := 
  Draw2D[{SimplexContourDraw[func, contours], SimplexBoundary}, opts, 
    AspectRatio -> Sqrt[3]/2]

(*
SimplexParametrixDraw
*)
(*
Notice that opts___ passes any additional options along to Show[].
*)
SimplexParametricDraw[func_] := 
  Module[{primitives},(*Off and On suppress ParametricPlot error messages*)
      Off[ParametricPlot::ppcom];
    primitives = ParametricDraw[Simplex2dCoord[func[x]], {x, 0, 1}];
    On[ParametricPlot::ppcom];
    primitives]
(*
SimplixListDraw
*)
SimplexListDraw[list_, opts___?OptionQ] := 
  Module[{cartesianList, output}, cartesianList = Map[Simplex2dCoord, list];
    ListDraw[cartesianList, opts]]

(*
SimplexDrawVectorField
*)
(*
SimplexDrawVectorField works as follows.Given arrow base point {y1,y2}, the \
equivalent point in the simplex is computed via Simplex2dInverseCoord, then \
the function v[{x1_,x2_,x3_}] to give the vector to plot,which is converted \
to cartesian coordinates via Simplex2dVector and then plotted. 
*)
SimplexDrawVectorField[v_] := 
  Module[{field},(*Off and On suppress ParametricPlot error messages*)Off[
      ParametricPlot::ppcom];
    field = 
      DrawVectorField[
        Simplex2dVector[Simplex2dInverseCoord[{y1, y2}], 
            v[Simplex2dInverseCoord[{y1, y2}]]]*
          WithinSimplexBoundaryNull[
            Simplex2dInverseCoord[{y1, 
                y2}]], {y1, .01, .99}, {y2, .01, .85}];
    On[ParametricPlot::ppcom];
    field]
(*
SimplexDraw3D
*)
SimplexDraw3D[func_, points_] := 
    Join[SimplexDraw3dUp[func, points], SimplexDraw3dDown[func, points]];

(*
SimplexDraw3DColor
*)
SimplexDraw3DColor[func_, points_, colorfn_] := 
    Join[SimplexDraw3dUpColor[func, points, colorfn], 
      SimplexDraw3dDownColor[func, points, colorfn]];

(*
General::"spell1": "Possible spelling error: new symbol name \
\"\!\(SimplexDraw3DColor\)\" is similar to existing symbol \
\"\!\(SimplexDraw3dColor\)\"."
*)
(*
SimplexDraw3dUp
*)
SimplexDraw3dUp[f_, p_] := Module[{s}, s = 3^(1/2)/2;
      Table[
        Polygon[{{(2n + m)/(2p), m s/p, 
              f[Simplex2dInverseCoord[{(2n + m)/(2p), m s/p}]]}, {(2n + 2 + 
                    m)/(2p), m s/p, 
              f[Simplex2dInverseCoord[{(2n + 2 + m)/(2 p), m s/p}]]}, {(2n + 
                    1 + m)/(2p), (m + 1)s/p, 
              f[Simplex2dInverseCoord[{(2n + 1 + m)/(2 p), (m + 1) s/
                        p}]]}}], {m, 0, p - 1}, {n, 0, p - m - 1}]];


(*
SimplexDraw3dDown
*)
SimplexDraw3dDown[f_, p_] := Module[{s}, s = 3^(1/2)/2;
      Table[
        Polygon[{{(2n + m)/(2p), m s/p, 
              f[Simplex2dInverseCoord[{(2n + m)/(2p), m s/p}]]}, {(2n + 2 + 
                    m)/(2p), m s/p, 
              f[Simplex2dInverseCoord[{(2n + 2 + m)/(2p), m s/p}]]}, {(2n + 
                    1 + m)/(2p), (m - 1)s/p, 
              f[Simplex2dInverseCoord[{(2n + 1 + m)/(2p), (m - 1)s/
                        p}]]}}], {m, 1, p - 1}, {n, 0, p - m - 1}]];

(*
SimplexDraw3dUpColor
*)
SimplexDraw3dUpColor[f_, p_, colorfn_] := Module[{s}, s = 3^(1/2)/2;
      Table[{SurfaceColor[
            colorfn[Simplex2dInverseCoord[{(2n + m + 1)/(2p), (m + 1/2)s/
                      p}]]], Polygon[{{(2n + m)/(2p), m s/p, 
                f[Simplex2dInverseCoord[{(2n + m)/(2p), m s/p}]]}, {(2n + 2 + 
                      m)/(2p), m s/p, 
                f[Simplex2dInverseCoord[{(2n + 2 + m)/(2 p), 
                      m s/p}]]}, {(2n + 1 + m)/(2p), (m + 1)s/p, 
                f[Simplex2dInverseCoord[{(2n + 1 + m)/(2 p), (m + 1) s/
                          p}]]}}]}, {m, 0, p - 1}, {n, 0, p - m - 1}]];


(*
SimplexDraw3dDownColor
*)
SimplexDraw3dDownColor[f_, p_, colorfn_] := Module[{s}, s = 3^(1/2)/2;
      Table[{colorfn[
            Simplex2dInverseCoord[{(2n + m + 1)/(2p), (m - 1/2)s/p}]],
          
          Polygon[{{(2n + m)/(2p), m s/p, 
                f[Simplex2dInverseCoord[{(2n + m)/(2p), m s/p}]]}, {(2n + 2 + 
                      m)/(2p), m s/p, 
                f[Simplex2dInverseCoord[{(2n + 2 + m)/(2p), m s/p}]]}, {(2n + 
                      1 + m)/(2p), (m - 1)s/p, 
                f[Simplex2dInverseCoord[{(2n + 1 + m)/(2p), (m - 1)s/
                          p}]]}}]}, {m, 1, p - 1}, {n, 0, p - m - 1}]];

(*
SimplexPolyGrid
*)
SimplexPolyGrid[p_] :=
  Module[{s, trigrid},
     s = 3^(1/2)/2;
     trigrid = N[Flatten[Join[{
              Table[
                Polygon[{{(2n + m)/(2p), m s/p}, {(2n + 2 + m)/(2p), 
                m s/p}, {(2n + 1 + m)/(2p), (m + 1)s/p}}], {m, 0, p - 1}, {n, 
                  0, p - m - 1}], 
        Table[Polygon[{{(2n + m)/(2p), m s/p}, {(2n + 2 + m)/(2p), 
                m s/p}, {(2n + 1 + m )/(2p), (m - 1)s/p}}], 
             {m, 1, p - 1}, {n, 0, p - m - 1}]}]]];
    trigrid /. Polygon[{a_, b_, c_}] -> Polygon[{a, b, c, a}]];
(*
SimplexContourDraw
*)
SimplexContourDraw[func_, contours_] := 
  ContourDraw[
      func[Simplex2dInverseCoord[{y/Sqrt[3] + x(1 - (2y)/(Sqrt[3])), y}]], {x,
         0, 1}, {y, 0, 3^(1/2)/2}, Contours -> contours, 
      ColorFunction -> Evaluate[ContourColors[#, contours] &], 
      PlotPoints -> 50] /. 
    DrawingTransform[#2/Sqrt[3] + #1(1 - 2*#2/Sqrt[3]) &, #2 &]

(*
Simplex2dCoord
*)
Simplex2dCoord[{x1_, x2_, x3_}] := 
  x1*{0, 0} + x2*{1, 0} + x3*{1/2, Sqrt[3]/2}

(*
Simplex2dInverseCoord
*)
Simplex2dInverseCoord[{y1_, y2_}] := {1, 0, 0} + y1*{-1, 1, 0} + 
    y2*{-1/Sqrt[3], -1/Sqrt[3], 2/Sqrt[3]}

(*
Simplex2dVector
*)
Simplex2dVector[{x1_, x2_, x3_}, {vx1_, vx2_, vx3_}] := 
  vx1*(-Simplex2dCoord[{x1, x2, x3}] + Simplex2dCoord[{1, 0, 0}])/
        DistanceApart[Simplex2dCoord[{x1, x2, x3}], 
          Simplex2dCoord[{1, 0, 0}]] + 
    vx2*(-Simplex2dCoord[{x1, x2, x3}] + Simplex2dCoord[{0, 1, 0}])/
        DistanceApart[Simplex2dCoord[{x1, x2, x3}], 
          Simplex2dCoord[{0, 1, 0}]] + 
    vx3*(-Simplex2dCoord[{x1, x2, x3}] + Simplex2dCoord[{0, 0, 1}])/
        DistanceApart[Simplex2dCoord[{x1, x2, x3}], 
          Simplex2dCoord[{0, 0, 1}]]

(*
WithinSimplexBoundary
*)
WithinSimplexBoundary[{x1_, x2_, x3_}] := 
  If[x1 >= 0 && x2 >= 0 && x3 >= 0, 1, 0]
(*
EndPackage
*)
End[]
(*
"Simplex`SimplexDrawGraphics`Private`"
*)
Protect[Evaluate[Context[] <> "*"]]
(*
{"Simplex3dPicture", "SimplexBoundary", "SimplexContourDraw", \
"SimplexContourPicture", "SimplexDraw3D", "SimplexDraw3dColor", \
"SimplexDraw3dDown", "SimplexDraw3dDownColor", "SimplexDraw3dUp", \
"SimplexDraw3dUpColor", "SimplexDrawVectorField", "SimplexListDraw", \
"SimplexParametricDraw", "SimplexPicture", "SimplexPolyGrid"}
*)
EndPackage[]