5
$\begingroup$

I wish to imitate the opacity plot as shown below:

Edit2: (ref: https://www.wolfram.com/mathematica/new-in-9/3d-volumetric-image-processing/edit-color-function-palette-for-image3d.html)

fig 1

Here is what I am up to now:

makeColorFn[colors_, opacities_, vars_] := 
  Transpose[{vars, MapThread[Append, {colors, opacities}]}] /. 
    body_ :> (Blend[body, #] &)

colors = 
  {RGBColor[0.761959, 0.470832, 0.940597], RGBColor[0.927848, 0.742785, 0.615138], 
   RGBColor[0.929162, 0.95034, 664815], RGBColor[0.431296, 0.709773, 0.927077]};

opacities = {0.632, 0.938, 0.906, 0.864};

keys = {0, 1/3, 2/3, 1};

mesh = 
  ParametricPlot[{v, u}, {v, 0, 1}, {u, 0, 1}, 
    MeshFunctions -> {#2 &, #1 &}, 
    MeshShading -> {{Gray, White}, {White, Gray}}, Mesh -> {20, 20}, 
    FrameLabel -> {"Intensity", Opacity}, 
    ColorFunction -> "", 
    PlotRange -> {0, 1}]

The above code was taken from here and gives me the following plot:

fig 2

If I now plot the color function on top of this background,

ListLinePlot[Transpose[{keys, opacities}], 
   Prolog -> mesh[[1]], 
   Mesh -> All, MeshStyle -> Directive[PointSize[Large], colors], 
   PlotRange -> Full, Filling -> Axis, 
   ColorFunction -> ColorTransferFunction[colors, opacities, keys], 
   Frame -> True, FrameLabel -> {"Intensity", "Opacity"}]

And the corresponding result is:

fig 3

Firstly, I need the plot to be scaled accordingly as in fig 2.

Secondly, I want the control points to be colored according to the colors and opacities at those points and not a single color (blue) as I have got.

[Optional: How can I remove the checkered background above the control points?]

Update

I have updated the code for plotting as follows:

DynamicModule[{points = Transpose[{keys, opacities}]},
  ListLinePlot[points, 
    Epilog -> {PointSize[0.03], Point[points, VertexColors -> colors]},
    Prolog -> mesh[[1]],
    PlotRange -> {{0., 1.}, {0., 1.}},
    Frame -> True,
    FrameLabel -> {"Intensity", "Opacity"},
    Filling -> Axis,
    ColorFunction -> ColorTransferFunction[colors, opacities, keys]]]

and got the result:

enter image description here

$\endgroup$
4
  • $\begingroup$ Please give a reference to the EditColorFunction you mention in the title. $\endgroup$
    – m_goldberg
    Commented May 23, 2017 at 1:03
  • $\begingroup$ @m_goldberg I have added the reference as per your request. $\endgroup$
    – user36426
    Commented May 23, 2017 at 9:21
  • $\begingroup$ What constitutes a full answer? Is bg scalling and clipping the only requirement? Are locators related? $\endgroup$
    – Kuba
    Commented May 23, 2017 at 12:26
  • $\begingroup$ @Kuba Since, now I've implemented my basic requirement, I want the background to look similar to the first figure. If you wish to contribute further such as allowing the control points to move within the plot, create new points or delete points please let me know so that I can update the question accordingly. $\endgroup$
    – user36426
    Commented May 23, 2017 at 13:48

2 Answers 2

3
$\begingroup$

Using Texture just like Kuba this is the lazy-person way to solve your issue. I just used your points because I didn't want to be clever or anything. I'm using Kuba's bg and his correction for the standard AspectRatio because it was too much work to adapt mesh. If you want different aspect ratios you'll need to correct the VertexTextureCoordinates appropriately.

DynamicModule[{points = Transpose[{keys, opacities}]},
 ListLinePlot[
  points,
  Epilog -> {
    PointSize[0.03],
    Point[points,
     VertexColors -> colors
     ]
    },
  Prolog -> {
    Texture@bg,
    With[{l =
       Join[
        {
         {0, 0}
         },
        points,
        {
         {1, 0},
         {0, 0}
         }]},
     Polygon[l,
      VertexTextureCoordinates ->
       Map[{GoldenRatio, 1}*# &, l]
      ]
     ]
    },
  PlotRange -> {{0., 1.}, {0., 1.}},
  Frame -> True,
  FrameLabel -> {"Intensity", "Opacity"},
  Filling -> Axis,
  ColorFunction -> (Append[RandomColor[], RandomReal[]] &)]
 ]

Looks like this (note that I used RandomColor because I didn't know your ColorTransferFunction:

example

$\endgroup$
4
  • $\begingroup$ You need to compensate for AspectRatio too as the grid is distorted. $\endgroup$
    – Kuba
    Commented May 24, 2017 at 7:01
  • $\begingroup$ @Kuba this is true. If we assume it's GoldenRatio then your suggestion generally works. I do get a weird tiling gap though. $\endgroup$
    – b3m2a1
    Commented May 24, 2017 at 7:02
  • $\begingroup$ Generation artifact, feel free to use mine bg. You have that gap already on the borders. $\endgroup$
    – Kuba
    Commented May 24, 2017 at 7:03
  • $\begingroup$ @Kuba good plan. I was able to mostly fix things by changing the PlotRange of the Graphics, but I prefer the appearance of yours. $\endgroup$
    – b3m2a1
    Commented May 24, 2017 at 7:08
2
$\begingroup$
bg = ImageResize[Image @ ArrayPad[{{1, .8}, {.8, 1}}, 5, "Periodic"], 400]

enter image description here

Firstly, I need the plot to be scaled accordingly as in fig 2.

Most of *Plot* functions have 1/GoldenRatio as an AspectRatio, it affects the texture too, we need to compensate for that by adjusting VertexTextureCoordinates:

Graphics[Disk[{0, 0}, .5]
  , AspectRatio -> 1/GoldenRatio
  , PlotRange -> 1
  , Frame -> True
  , Prolog -> {
        Texture[bg], Polygon[
            Scaled /@ {{0, 0}, {1, 0}, {1, 1}, {0, 1}}
          , VertexTextureCoordinates -> {
                {0, 0}, {GoldenRatio, 0}, {GoldenRatio, 1}, {0, 1}
            }
        ]
    }
]

enter image description here

Secondly, I want the control points to be colored according to the colors and opacities at those points and not a single color (blue) as I have got.

Solved by OP.

[Optional: How can I remove the checkered background above the control points?]

Striaghtorward way is to apply Texture only to a polygon which consists of your points and bottom corners of the plot. But it is easier to control VertexTextureCoordinates for fixed rectangular polygon so the other way is to draw a white one over it:

... Prolog -> {
        ... 
      , White, Polygon[{{-1, .5}, {.5, 0}, {1, 1}, {-1, 1}}]
    }
...

enter image description here

$\endgroup$
5
  • $\begingroup$ you can also get most of the way there using the points the OP defined, e.g: Prolog -> { Texture@Graphics@mesh[[1]], With[{l = Append[Prepend[points, {0, 0}], {1, 0}]}, Polygon[l, VertexTextureCoordinates -> l] ] } $\endgroup$
    – b3m2a1
    Commented May 24, 2017 at 6:52
  • $\begingroup$ @MB1965 started with that but somehow I couldn't make it perfectly non distorted grid. Could you share full code? $\endgroup$
    – Kuba
    Commented May 24, 2017 at 6:55
  • $\begingroup$ sure I'll post what I have. $\endgroup$
    – b3m2a1
    Commented May 24, 2017 at 6:56
  • $\begingroup$ @MB1965 otoh VertexTextureCoordinates -> ({GoldenRatio, 1} # & /@ l) seems to work. $\endgroup$
    – Kuba
    Commented May 24, 2017 at 6:57
  • $\begingroup$ @Kuba : Thanks for your answer. You got the background in a really simple way. And you are right that the golden ratio is really important here. Is it explicitly mentioned in the documentation? I'm following MB1965's answer with your recommendation. Just one observation: despite having the original texture image a square, the final plot doesn't seem to maintain that aspect ratio. Is it also due to the same? $\endgroup$
    – user36426
    Commented May 24, 2017 at 8:48

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.