4
$\begingroup$

Context

Recently, Bob Sandheinrich published a very useful code to change interactively colours of a given plot as follows:

  cc = ResourceFunction["ColorChanger"]

  pl= Plot[{Sin[x],Cos[x]},{x,0,2Pi}]

enter image description here

which allows the user to write

   pl//cc

enter image description here

But this function does not work e.g. for ContourPlot.


Question

Would it be possible to extend this function so as to be able to either change each colour, or replace the ColorTable with another one?


Expected features

  • Ideally, one would like to interface to the builtin colour picker

enter image description here

so that, when applied to

 pl2 = ContourPlot[Sin[x y], {x, 0, 1}, {y, 0, 1}]

enter image description here

 cc//pl2 

would allow the user to change the sets of contour colours?

This is related to the builtin functions ImageRecolor and may make use of DominantColors

Attempt

I can extract the colors from the contour plot

    col = Select[DominantColors[pl], 
       Most[#] != RGBColor[{0., 0., 0.}] &] // Sort;  rr = Thread[
   col -> (ColorData["AvocadoColors"] /@ 
      Subdivide[0, 1, Length[col] - 1])];
rr // TableForm

enter image description here

$\endgroup$

2 Answers 2

5
$\begingroup$

Maybe something like:

reColor[colorScheme_String : "Rainbow"] := 
  Module[{cl = ColorData[colorScheme] /@ 
       Subdivide[CountDistinct[Cases[#, _?ColorQ, All]]]}, 
    ReplaceAll[c_?ColorQ :> Last[cl = RotateLeft[cl]]]@#] &;

Examples:

plot = ContourPlot[Sin[x y], {x, 0, 1}, {y, 0, 1}, 
   ColorFunction -> "BrightBands", ImageSize -> Medium, ContourStyle -> None];

Row[{plot, reColor[]@plot}, Spacer[10]]

enter image description here

Row[{plot, reColor["TemperatureMap"]@plot}, Spacer[10]]

enter image description here

plot2 = ContourPlot[Sin[x y], {x, 0, 1}, {y, 0, 1}, 
  Contours -> 35, ImageSize -> Medium, ContourStyle -> None]; 

Row[{plot2, reColor["AvocadoColors"]@plot2}, Spacer[10]]

enter image description here

Update

Using reColor with MarcoB's Manipulate interface:

Manipulate[
 ClickToCopy[reColor[First @ fun] @ Show[plot2, PlotLabel -> First[fun]]], 
 {{fun, {"WL13DefaultDensityGradient"}, "color function"}, 
    ColorData["Gradients"], ListPicker}]

enter image description here

enter image description here

Update 2: Re-coloring plot and legend

reColorLegendedPlot[cf_] :=  ReplaceAll[
  Legended[a_, Placed[BarLegend[{_, v_}, rest___], place___]] :> 
   Legended[reColor[cf]@Show[a, PlotLabel -> cf], 
    Placed[BarLegend[{Blend[cf, #] &, v}, rest], place]]]

Examples:

gradientcolors = Prepend["WL13DefaultDensityGradient"] @ ColorData["Gradients"];

labels = Map[Labeled[ColorData[#, "Image"], Style[#, 12], {{Top, Left}}]&]@
   gradientcolors;

Manipulate[ClickToCopy[reColorLegendedPlot[First@fun]@plot2],
 Spacer[10], 
 Style["color function", 14], 
 Spacer[10], 
 Row[{Spacer[10], 
   Control@{{fun, {"WL13DefaultDensityGradient"}, ""}, 
     Thread[gradientcolors -> labels], ListPicker, 
     Appearance -> "Frameless", ImageSize -> {280, 330}}, 
   Spacer[30]}], 
 ControlPlacement -> Left]

enter image description here

enter image description here

enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ You might want to advertise that reColor works with plot = Plot3D[{Sin[x^2 + y], Cos[x^2 + y]}, {x, 0, Pi}, {y, 0, Pi}, PlotLegends -> Automatic] $\endgroup$
    – chris
    Commented Nov 19, 2023 at 11:47
  • 1
    $\begingroup$ Though sometimes with some unexpected result! pl = Plot3D[Im[ArcSin[(x + I y)^3]], {x, -2, 2}, {y, -2, 2}, ColorFunction -> Function[{x, y, z}, Hue[z]]] $\endgroup$
    – chris
    Commented Nov 19, 2023 at 11:50
  • $\begingroup$ @chris, I am surprised that it works for any *Plot function other than ContourPlot. It would take more work to make reColor/reColorLegendedPlot work with (1) arbitrary color function other than the built-in gradient colors with string names, and (2) *Plot functions that style primitives using VertexColors. $\endgroup$
    – kglr
    Commented Nov 19, 2023 at 12:39
4
$\begingroup$

Something similar could be built with a Manipulate interface:

Manipulate[
 ClickToCopy[
  ContourPlot[Sin[x y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> fun, ImageSize -> Medium]
 ],
 {
  {fun, Automatic, "color function"},
   ColorData["Gradients"],
   ListPicker
  }
]

interface

Once you have selected your preferred color scheme, the ClickToCopy wrapper allows you to click on the resulting plot within the Manipulate to copy it to clipboard, and from there you can then paste it wherever you need it.

$\endgroup$
1
  • 1
    $\begingroup$ Using @kgrl answer together with yours you can do: Manipulate[ClickToCopy[reColor[First@fun]@plot// Evaluate], {{fun, {Automatic}, "color function"}, ColorData["Gradients"], ListPicker}] which addresses exactly my OP. Thanks to both! $\endgroup$
    – chris
    Commented Nov 19, 2023 at 0:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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