4
$\begingroup$

I wonder if there is a way to extract existing ColorFunction and "override" it with a new function that will depend on original one. This question discusses different ways how to add transparency to 3D plot, including an "extraction procedure" proposed by @RunnyKine:

Trace[Plot[Sin[x], {x, 0, 2 Pi}], _Blend & ] // 
  Flatten // ReleaseHold
Trace[Plot[Sin[x], {x, 0, 2 Pi}, 
    ColorFunction -> "Rainbow"], _Blend &] // Flatten // ReleaseHold
Trace[Plot[Sin[x], {x, 0, 2 Pi}, 
    ColorFunction -> (#^2 &)], _Blend &] // Flatten // ReleaseHold

It works if you know in advance that the ColorFunction uses Blend, but for general ColorFunction (case three in the above code) it doesn't work. These were just examples to illustrate the extraction algorithm. I want a procedure that will work for any plotting object without any assumptions about its ColorFunction.

Is there a way to obtain ColorFunction from plotting functions? I wonder if I'm missing some simple solution a la

ColorFunction /. Options[Plot] (* Automatic .. not very useful *)
$\endgroup$
  • 1
    $\begingroup$ How about: Trace[Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction ->(#^2 &)], HoldPattern@Rule[ColorFunction, _]] // Flatten $\endgroup$ – RunnyKine Apr 18 '16 at 22:36
  • $\begingroup$ ArrayPlot[RandomReal[{0, 1}, {10, 10}]] ? Your Trace gets empty list... $\endgroup$ – BlacKow Apr 18 '16 at 22:57
  • $\begingroup$ @Kuba I agree the question needs some editing. $\endgroup$ – RunnyKine Apr 19 '16 at 7:18
  • $\begingroup$ @Kuba I edited the question $\endgroup$ – BlacKow Apr 19 '16 at 14:28
  • $\begingroup$ @Kuba The Trace was proposed as a possible solution for extracting ColorFunction from a plot. The examples show that it works sometime, but it fails for other cases. Generally I don't know in advance that the Blend was used. I want a procedure that treats a Plot as a black box and gives me the ColorFunction that will be used when this Plot is evaluated. $\endgroup$ – BlacKow Apr 19 '16 at 14:39
5
$\begingroup$

This doesn't allow the extraction and reconstruction of the unknown ColorFunction, but it does allow to override it with an exact duplicate that is transparent,

plt1 = Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> (#^2 &),
    ImageSize -> 300];
plt2 = Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> (Hue[#^2] &), 
   ImageSize -> 300];
plt3 = Plot[Sin[x], {x, 0, 2 Pi}, 
   ColorFunction -> (LABColor[#^2, #, 1 - #] &), ImageSize -> 300];
{plt1, plt2, plt3}
{plt1, plt2, plt3} /. a_ /; ColorQ[a] :> Directive[Opacity[.5], a]

enter image description here

Edit

So extracting a color function from a plot is not simple, and I haven't got a one-size fits all solution. Basically, you need to extract the colors from the plot, extract the points, order the colors and the points together, and then use Blend to create a color interpolating function.

To top it off, the original plot may have used x or y to base their color function on. Here's an example, where I use a ColorFunction which is just a modified form of one of the built-in.

reconstructColorFunction[plt2_] := 
 Module[{order, points, colors, reconstructedcolorfunc1, 
   reconstructedcolorfunc2},
  order = Cases[plt2, Line[{a__}, b__] :> a, Infinity];
  points = 
   Cases[plt2, GraphicsComplex[{a__}, b__] :> a, Infinity][[order]];
  colors = (Cases[plt2, Rule[VertexColors, {a__}] :> a, 
       Infinity] /. {a_?(SameQ[ArrayDepth[#], 2] &) :> (RGBColor /@ 
          a), a_?(SameQ[ArrayDepth[#], 1] &) :> (GrayLevel /@ 
          a)})[[order]];
  reconstructedcolorfunc1 = 
   Blend[Transpose[{points[[All, 1]], colors}], #] &;
  reconstructedcolorfunc2 = 
   Blend[Transpose[{points[[All, 2]], colors}], #] &;
  {BarLegend[{reconstructedcolorfunc1[#] &, 
     MinMax@points[[All, 1]]}],
   BarLegend[{reconstructedcolorfunc2[#] &, 
     MinMax@points[[All, 2]]}]}
  ]

Here it is tested on a few built-in color functions

{plot1, plot2, plot3, 
  plot4} = {Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> (#2^2 &), 
   ImageSize -> 300],
  Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> (#1^2 &), 
   ImageSize -> 300],
  Plot[Sin[x], {x, 0, 2 Pi}, 
   ColorFunction -> (ColorData["BlueGreenYellow"][#2^2] &), 
   ImageSize -> 300],
  Plot[Sin[x], {x, 0, 2 Pi}, 
   ColorFunction -> (ColorData["BlueGreenYellow"][#1^2] &), 
   ImageSize -> 300]}

enter image description here

reconstructColorFunction /@ {plot1, plot2, plot3, plot4}

enter image description here

$\endgroup$
  • $\begingroup$ That's really nice (although I need to work with your code to fully understand it) but I was really into extracting ColorFunction. I edited my question to reflect this. $\endgroup$ – BlacKow Apr 19 '16 at 14:30
  • $\begingroup$ @BlacKow - I don't know that you can recover the exact original color function, but you can reconstruct it with a lot of work. See the edit, it isn't a black box, but it works on what I've tried so far. $\endgroup$ – Jason B. Apr 19 '16 at 15:32
3
$\begingroup$

I don't think it's possible to extract such information from an already evaluated plot. Plot returns a Graphics object and very little meta-information is stored. We can see this by inspecting with InputForm.

InputForm[Plot[1, {x, 0, 1}, ColorFunction -> Hue, PlotPoints -> 2]]
Graphics[{GraphicsComplex[{{1.*^-6, 1.}, {0.999999, 1.}, {0.5, 1.}}, 
 {{{}, {}, {Directive[Opacity[1.], RGBColor[0.368417, 0.506779, 0.709798], AbsoluteThickness[1.6]], Line[{1, 3, 2}, VertexColors -> Automatic]}}}, 
 VertexColors -> {Hue[0.], Hue[0.], Hue[0.]}], {}}, {DisplayFunction -> Identity, PlotRangePadding -> {{Scaled[0.02], Scaled[0.02]}, {Scaled[0.05], Scaled[0.05]}}, 
 PlotRangeClipping -> True, ImagePadding -> All, DisplayFunction -> Identity, AspectRatio -> GoldenRatio^(-1), Axes -> {True, True}, AxesLabel -> {None, None}, 
 AxesOrigin -> {0, 0}, DisplayFunction :> Identity, Frame -> {{False, False}, {False, False}}, FrameLabel -> {{None, None}, {None, None}}, 
 FrameTicks -> {{Automatic, Automatic}, {Automatic, Automatic}}, GridLines -> {None, None}, GridLinesStyle -> Directive[GrayLevel[0.5, 0.4]], 
 Method -> {"DefaultBoundaryStyle" -> Automatic, "DefaultMeshStyle" -> AbsolutePointSize[6], "ScalingFunctions" -> None}, PlotRange -> {{0, 1}, {0., 2.}}, 
 PlotRangeClipping -> True, PlotRangePadding -> {{Automatic, Automatic}, {Automatic, Automatic}}, Ticks -> {Automatic, Automatic}}]

But we can somewhat reverse engineer the ColorFunction and approximate it with interpolating functions.

First here's a plot with a custom ColorFunction:

plot = Plot[Sin[Pi x], {x, -1, 1}, 
  ColorFunction -> (ColorData["FruitPunchColors", Max[-#1, #2]] &)]

enter image description here

Now extract the data points and the color information. Note colors are either stored as an array or as explicit colors, so we need to check for both. Also if there was no ColorFunction to begin with, this method will fail, though one could modify the code to account for that case.

pts = First[Cases[plot, GraphicsComplex[l_, ___] :> l, Infinity]];
colors = First[Join[
  Cases[plot, _[VertexColors, l_?ArrayQ] :> l, Infinity],
  Cases[plot, _[VertexColors, l:{__?ColorQ}] :> List @@@ ColorConvert[l, "RGB"], Infinity]
]];

Now interpolate.

{red, green, blue} = 
  Interpolation[Transpose[{pts, #}], InterpolationOrder -> 1] & /@ Transpose[colors];

Now here's where it gets a bit hand-wavy. Our data is not of full measure, so extrapolation will need to be used. It seems like restricting the domain to the convex hull of our data gives reasonable results though.

dom = ConvexHullMesh[pts];
Show[dom, plot]

enter image description here

And now sample values only in this domain. They look reasonable to me.

Plot3D[
  {red[x, y], green[x, y], blue[x, y]}, 
  {x, y} ∈ dom, 
  AxesLabel -> {"x", "y", "z"}, 
  Mesh -> None, 
  PlotStyle -> {Red, Green, Blue}
]

enter image description here

I'm not sure if I've really addressed your question. So please ask if you'd like me to elaborate on something.

$\endgroup$
  • $\begingroup$ Nice - I think I came to a very similar solution with my edit, went through almost at the same time. Yours is easier to read - I thought it was necessary to reorder the points in the order they are plotted before making the interpolation function (if you try ListLinePlot[pts] then you see they appear to be in random order), but apparently I was wrong. Also, it's tricky when GrayLevel is used as the original ColorFunction because then the VertexColors are stored as a 1-dimensional list. $\endgroup$ – Jason B. Apr 20 '16 at 7:23
  • $\begingroup$ @JasonB I was not aware GrayLevel could be specified with a one dimensional list, thanks! I think all valid specs are listed in the details section here. $\endgroup$ – Chip Hurst Apr 20 '16 at 14:44
  • $\begingroup$ @JasonB And about interpolation, I realized they didn't need to be in order because Interpolation threw me the message udeg (see here). This doc page gives insight on the interpolation method used: It involves taking working the convex hull of the points, and hence any ordering is ignored. I think this is why restricting the domain to the convex hull works well but larger domains don't. $\endgroup$ – Chip Hurst Apr 20 '16 at 14:48
2
$\begingroup$

It looks like the original method was copied from my answer to The default ColorFunction of DensityPlot before v10? That was not intended to be a universal reusable function, only an expedient interactive way to get the information desired.

Neither that original case nor as I perceive them the examples in your own question require the recovery of a color function from an already evaluated Plot as JasonB and Chip Hurst attempted; that is surely a far harder problem! I think instead you "merely" need to find what the color function either is defined by or will resolve to for an unevaluated Plot expression.

It is easy enough to extract an explicitly specified ColorFunction, or one specified with SetOptions, using a replacement rule and OptionValue.* However this does not easily find values set through the Plot Theme or resolve Automatic into an actual color function. The Theme case could be handled as done in How to access new colour schemes in version 10? or Match colors to plot themes but one will find that that sometimes resolves to Automatic, and it turns out we can handle both using one method so I propose skipping PlotTheme resolution.

For this we can use Trace as we started with but we need to make it more general. A bit of spelunking indicates that we can intercept Legend information to do this.

Attributes[getLegendData] = HoldFirst;

getLegendData[expr_, key_String] :=
  Flatten[
    Trace[expr, System`ProtoPlotDump`legendData @ key, TraceForward -> True]
  ][[2, 1]]

Testing:

p[1] := Plot[Sin[x], {x, 0, 2 Pi}];
p[2] := Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> "Rainbow"];
p[3] := Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> (#^2 &)];
p[4] := DensityPlot[x y, {x, y} ∈ Disk[], PlotTheme -> "Classic"]
p[5] := DensityPlot[x y, {x, y} ∈ Disk[]]

getLegendData[p[#], "ColorFunction"] & ~Array~ 5 // Column

enter image description here

  • Note that the second argument is a String, "ColorFunction".

  • Strings that appear in this Trace are known to include

    {"ArgumentExpression", "ArgumentLength", "AspectRatio", "AutoLegend", "BarOrigin", 
    "BaseStyle", "BoundaryStyle", "ChartBaseStyle", "ChartElements", "ChartLayout", 
    "ChartStyle", "ColorFunction", "ColorFunctionScaling", "Contours", "DataExtremes", 
    "DefaultLabels", "DefaultLegendFunction", "DefaultOptions", "Depth", "Dimensions", 
    "ImageSize", "Joined", "LabelStyle", "LegendAppearance", "PlotMarkers", 
    "PlotStyle", "StyleWrappers", "WrapperLegends"}
    

* Since Trace involves evaluation of the Plot we may sometimes want the simpler but less robust method. Here is a generalized function to complement setOpts from Setting options of expressions similar to using SetOptions on objects:

Attributes[getOpts] = HoldFirst;

getOpts[p : h_[___], option_] :=
  Unevaluated[p] /.
    HoldPattern[h][___, OptionsPattern[]] :>
      OptionValue[option]

Now:

getOpts[Plot[Sin[x], {x, 0, 2 Pi}], ColorFunction]

getOpts[Plot[Sin[x], {x, 0, 2 Pi}, ColorFunction -> (#^2 &)], ColorFunction]

getOpts[Grid[{}, Background -> Red], {Alignment, Frame, Background}]
Automatic

#1^2 &

{{Center, Baseline}, None, RGBColor[1, 0, 0]}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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