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

Re: ListContourPlot Color

• To: mathgroup at smc.vnet.net
• Subject: [mg31513] Re: ListContourPlot Color
• From: "Allan Hayes" <hay at haystack.demon.co.uk>
• Date: Thu, 8 Nov 2001 04:55:54 -0500 (EST)
• References: <9sb4pf$gg4$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

<Moranresearch at aol.com> wrote in message news:9sb4pf$gg4$1 at smc.vnet.net...
> Is the a way to assign specific colors to the intervals between individual
> contours?
> Thank you. John R Moran PhD,MD
>

John,

Here is a way:

Notebook[{

Cell[CellGroupData[{
Cell["Specifying the colors of contour regions", "Subsubsection"],

Cell[TextData[{
  "Suppose that we wish to draw several contour plots with  ",
  StyleBox["Contours \[Rule] {z",
    FontFamily->"Courier"],
  StyleBox["1",
    FontFamily->"Courier",
    FontVariations->{"CompatibilityType"->"Subscript"}],
  StyleBox[",z",
    FontFamily->"Courier"],
  StyleBox["2",
    FontFamily->"Courier",
    FontVariations->{"CompatibilityType"->"Subscript"}],
  StyleBox[",..}",
    FontFamily->"Courier"],
  "and have the same colors correspond to the same height intervala. \
The following function will construct an appropriate color function. \
Note that this only works if we set\n",
  StyleBox["ColorFunctionScaling\[Rule]False",
    FontFamily->"Courier"],
  " in ",
  StyleBox["ContourPlot",
    FontFamily->"Courier"],
  "."
}], "Text"],

Cell[BoxData[
    RowBox[{
      RowBox[{
        RowBox[{"MakeColorFunction", "[",
          RowBox[{
            RowBox[{"cntrs_", "?", "OrderedQ"}], ",", " ", "clrs_"}],
          "]"}], "/;",
        RowBox[{
          RowBox[{"Length", "[", "clrs", "]"}], "==",
          RowBox[{
            RowBox[{"Length", "[", "cntrs", "]"}], "+", "1"}]}]}], ":=",
       "\[IndentingNewLine]",
      RowBox[{"Function", "@@",
        RowBox[{"{",
          RowBox[{"Which", "@@",
            RowBox[{"Flatten", "[",
              RowBox[{"{",
                RowBox[{
                  RowBox[{"{",
                    RowBox[{
                      RowBox[{"#", "\[LessEqual]", " ",
                        RowBox[{"cntrs", "[",
                          RowBox[{"[", "1", "]"}], "]"}]}], ",",
                      RowBox[{"clrs", "[",
                        RowBox[{"[", "1", "]"}], "]"}]}], "}"}], ",",

                  RowBox[{"Table", "[",
                    RowBox[{
                      RowBox[{"{",
                        RowBox[{
                          RowBox[{
                            RowBox[{"cntrs", "[",
                              RowBox[{"[", "i", "]"}], "]"}], "<",
                            "#", "\[LessEqual]",
                            RowBox[{"cntrs", "[",
                              RowBox[{"[",
                                RowBox[{"i", "+", "1"}], "]"}],
                              "]"}]}], ",",
                          RowBox[{"clrs", "[",
                            RowBox[{"[",
                              RowBox[{"i", "+", "1"}], "]"}], "]"}]}],
                         "}"}], ",",
                      RowBox[{"{",
                        RowBox[{"i", ",", "1", ",", " ",
                          RowBox[{
                            RowBox[{"Length", "[", "cntrs", "]"}],
                            "-", "1"}]}], "}"}]}], "]"}], ",",
                  RowBox[{"{",
                    RowBox[{
                      RowBox[{
                        RowBox[{"cntrs", "[",
                          RowBox[{"[",
                            RowBox[{"-", "1"}], "]"}], "]"}],
                        "\[LessEqual]", "#"}], ",",
                      RowBox[{"clrs", "[",
                        RowBox[{"[",
                          RowBox[{"-", "1"}], "]"}], "]"}]}], "}"}]}],
                 "}"}], "\[IndentingNewLine]", "]"}]}],
          "}"}]}]}]], "Input"],

Cell["For example, we get", "Text"],

Cell[CellGroupData[{

Cell[BoxData[
    RowBox[{"MakeColorFunction", "[",
      RowBox[{
        RowBox[{"{",
          RowBox[{"z1", ",", "z2", ",", "z3"}], "}"}], ",",
        RowBox[{"{",
          RowBox[{"c1", ",", "c2", ",", "c3", ",", "c4"}], "}"}]}],
      "]"}]], "Input"],

Cell[BoxData[
    RowBox[{
      RowBox[{"Which", "[",
        RowBox[{
          RowBox[{"#1", "\[LessEqual]", "z1"}], ",", "c1", ",",
          RowBox[{"z1", "<", "#1", "\[LessEqual]", "z2"}], ",", "c2",
          ",",
          RowBox[{"z2", "<", "#1", "\[LessEqual]", "z3"}], ",", "c3",
          ",",
          RowBox[{"z3", "\[LessEqual]", "#1"}], ",", "c4"}], "]"}],
      "&"}]], "Output"]
}, Open  ]],

Cell["Let's make a plot.", "Text"],

Cell[BoxData[
    RowBox[{"<<", "Graphics`Colors`"}]], "Input"],

Cell[BoxData[{
    RowBox[{
      RowBox[{"cntrs", "=", " ",
        RowBox[{"{",
          RowBox[{
            RowBox[{"-", ".9"}], ",",
            RowBox[{"-", ".6"}], ",",
            RowBox[{"-", ".3"}], ",", "0", ",", ".3", ",", ".6", ",",
            ".9"}], "}"}]}], ";"}], "\[IndentingNewLine]",
    RowBox[{
      RowBox[{"clrs", " ", "=", " ",
        RowBox[{"{",
          RowBox[{
          "Red", ",", "Blue", ",", "LightSeaGreen", ",",
            "YellowBrown", ",", "Khaki", ",", "Green", ",", " ",
            "Purple", ",", "Yellow"}], "}"}]}], ";"}]}], "Input"],

Cell[BoxData[
    RowBox[{
      RowBox[{
        RowBox[{"ContourPlot", "[",
          RowBox[{
            RowBox[{
              RowBox[{"(",
                RowBox[{
                  RowBox[{"Cos", "[", "x", "]"}], "+",
                  RowBox[{"Sin", "[", "y", "]"}]}], ")"}], "/", "2"}],
             ",",
            RowBox[{"{",
              RowBox[{"x", ",", "0", ",",
                RowBox[{"2", "Pi"}]}], "}"}], ",",
            RowBox[{"{",
              RowBox[{"y", ",", "0", ",",
                RowBox[{"2", "Pi"}]}], "}"}], ",",
            "\[IndentingNewLine]",
            RowBox[{"Contours", "\[Rule]", "  ", "cntrs"}], ",",
            "\[IndentingNewLine]",
            RowBox[{"ColorFunction", " ", "\[Rule]", " ",
              RowBox[{"(",
                RowBox[{"MakeColorFunction", "[",
                  RowBox[{"cntrs", ",", "clrs"}], "]"}], ")"}]}], ",",
             "\[IndentingNewLine]",
            RowBox[{
            "ColorFunctionScaling", " ", "\[Rule]", "False"}]}],
          "]"}], ";"}], "\[IndentingNewLine]"}]], "Input"],

Cell[BoxData[
    RowBox[{
      RowBox[{"dat", " ", "=", " ",
        RowBox[{"Table", "[",
          RowBox[{
            RowBox[{
              RowBox[{"(",
                RowBox[{
                  RowBox[{"Cos", "[", "x", "]"}], "+",
                  RowBox[{"Sin", "[", "y", "]"}]}], ")"}], "/", "2"}],
             ",",
            RowBox[{"{",
              RowBox[{"x", ",", "0", ",",
                RowBox[{"2", "Pi"}], ",", " ",
                RowBox[{"Pi", "/", "10"}]}], "}"}], ",",
            RowBox[{"{",
              RowBox[{"y", ",", "0", ",",
                RowBox[{"2", "Pi"}], ",",
                RowBox[{"Pi", "/", "10"}]}], "}"}]}], "]"}]}],
      ";"}]], "Input"],

Cell[BoxData[
    RowBox[{
      RowBox[{"ListContourPlot", "[",
        RowBox[{"dat", ",", "\[IndentingNewLine]",
          RowBox[{"Contours", "\[Rule]", "  ", "cntrs"}], ",",
          "\[IndentingNewLine]",
          RowBox[{"ColorFunction", " ", "\[Rule]", " ",
            RowBox[{"(",
              RowBox[{"MakeColorFunction", "[",
                RowBox[{"cntrs", ",", "clrs"}], "]"}], ")"}]}], ",",
          "\[IndentingNewLine]",
          RowBox[{"ColorFunctionScaling", " ", "\[Rule]", "False"}]}],
         "]"}], ";"}]], "Input"]
}, Open  ]]
},
FrontEndVersion->"4.1 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 723}},
WindowSize->{694, 668},
WindowMargins->{{146, Automatic}, {-23, Automatic}},
ShowCellLabel->False
]

--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565