4
$\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$
  • $\begingroup$ Please give a reference to the EditColorFunction you mention in the title. $\endgroup$ – m_goldberg May 23 '17 at 1:03
  • $\begingroup$ @m_goldberg I have added the reference as per your request. $\endgroup$ – Majis May 23 '17 at 9:21
  • $\begingroup$ What constitutes a full answer? Is bg scalling and clipping the only requirement? Are locators related? $\endgroup$ – Kuba May 23 '17 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$ – Majis May 23 '17 at 13:48
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$
  • $\begingroup$ You need to compensate for AspectRatio too as the grid is distorted. $\endgroup$ – Kuba May 24 '17 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 May 24 '17 at 7:02
  • $\begingroup$ Generation artifact, feel free to use mine bg. You have that gap already on the borders. $\endgroup$ – Kuba May 24 '17 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 May 24 '17 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$
  • $\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 May 24 '17 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 May 24 '17 at 6:55
  • $\begingroup$ sure I'll post what I have. $\endgroup$ – b3m2a1 May 24 '17 at 6:56
  • $\begingroup$ @MB1965 otoh VertexTextureCoordinates -> ({GoldenRatio, 1} # & /@ l) seems to work. $\endgroup$ – Kuba May 24 '17 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$ – Majis May 24 '17 at 8:48

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.