2
$\begingroup$

I have been experimenting with interactive color bars to supplement graphical information presented as a colored ribbon. Here is an example:

First, generate some colours as red/green/blue triples:

seq = Apply[List, ColorData["NeonColors"][#] & /@ Range[0, 1, 0.01], 
   2];

Next, code a function to display the ribbon. This function generates a list of small images, each of which is annotated by a tooltip giving information related to the image, e.g. RGB. These images are then aggregated using GraphicsRow.

ribbon1[colourList_, infoList_] := Module[{pairList, h},
  pairList = Transpose[{colourList, infoList}];
  h = Floor[0.5 Length[colourList]]; (* keeps ribbon height constant *)
  GraphicsRow[
   Tooltip[Image[ConstantArray[#[[1]], {h, 10}]], #[[2]]] & /@ 
    pairList,
   Spacings -> {0, 0}]
]
  

Next, show the ribbon

ribbon1[seq, seq]

enter image description here

When implemented in Mathematica, the ribbon is interactive. In this example, as you move the mouse over the different colour stripes, a tooltip gives the RGB triple for the colour.

My problem is this. Generating the ribbon (using ribbon1[]) takes 34 s which makes using the function rather unwieldy. Is there a way to speed up the function? The problem seems to lie with the use of GraphicsRow.

The following gives code which generates just the ribbon without the tooltips and executes in .008 s - much quicker than the above. However, I need the tooltips!

ribbon2[colourList_] := Module[{h},
  h = Floor[0.5 Length[colourList]]; (* keeps ribbon height constant *)
  Image[
   Transpose[Catenate[ConstantArray[#, {10, h}] & /@ colourList]],
   ImageSize -> Large]
  ]

PS The approach used in ribbon1[] is very versatile. For example, using EventHandler rather than Tooltip allows one to implement a primitive musical keyboard!

beep[f_] := EmitSound[Play[Sin[10 f 2 Pi t], {t, 0, 0.3}]]
ribbon3[colourList_, infoList_] := Module[{pairList, h},
  pairList = Transpose[{colourList, infoList}];
  h = Floor[0.5 Length[colourList]]; (* keeps ribbon height constant *)
  GraphicsRow[
   EventHandler[
      Image[ConstantArray[#[[1]], {h, 10}]], {{"MouseClicked", 1} :> 
        beep[#[[2]]]}] & /@ pairList,
   Spacings -> {0, 0}]
  ]
ribbon3[seq, Range[Length[seq]]
$\endgroup$
1
  • $\begingroup$ An alternate approach, evaluate: Tooltip[ ColorSlider[ Dynamic[ swatchColor], AppearanceElements -> "Swatch" ], Dynamic[ FullForm[ swatchColor ]]]. The Tooltip for the swatch gives the RGBColor. Click on the swatch for multiple selector options. $\endgroup$ – Bob Hanlon May 27 at 14:55
3
$\begingroup$

You can use the fact that Tooltip, EventHandler, etc. are all valid wrappers for graphics primitives:

ribbon4[colourList_, infoList_] := Graphics[
  MapThread[
   {
     RGBColor @@ #2,
     Tooltip[
      Rectangle@{#, 0},
      #3
      ]
     } &,
   {
    Range@Length@colourList,
    colourList,
    infoList
    }
   ],
  ImageSize -> {600, 35},
  AspectRatio -> Full,
  PlotRange -> {{0, Length@colourList}, {0, 1}}
  ]

AbsoluteTiming@ribbon4[seq, seq]

enter image description here

Compare this with your approach:

AbsoluteTiming@ribbon1[seq, seq]

enter image description here

This is over 5 orders of magnitude faster1. This works by essentially creating colored rectangles/squares with the appropriate tooltip. The size of the bar is controlled via ImageSize.

This can also easily be adapted to your interactive piano:

ribbon6[colourList_, infoList_] := Graphics[
  MapThread[
   {
     RGBColor @@ #2,
     EventHandler[
      Rectangle@{#, 0},
      {{"MouseClicked", 1} :> beep[#3]}
      ]
     } &,
   {
    Range@Length@colourList,
    colourList,
    infoList
    }
   ],
  ImageSize -> {600, 35},
  AspectRatio -> Full,
  PlotRange -> {{0, Length@colourList}, {0, 1}}
  ]

1 It should be noted that AbsoluteTiming does not account for the time taken by the front-end to actually display the expression. Since this is essentially the only thing happening in ribbon4, the time reported is almost 0. Note however that the expression resulting from ribbon1 is way more complex than that, so even that step is slower for your approach.

$\endgroup$
1
  • $\begingroup$ That's very helpful, thank-you @lukas. The question I asked was a simplified version of what I actually wanted; however, the approach you have described has enabled me to address the full problem - see below. $\endgroup$ – robertofbaycot May 31 at 8:42
0
$\begingroup$

I am interested in the use of channel mixing matrices to induce colour changes in images. A basic example of a mixing matrix is:

(base = {{0, 1, 0}, {0, 0, 1}, {1, 0, 0}})

This gives a 3x3 matrix

0 1 0
0 0 1
1 0 0

In an RGB colour, this replaces the red channel with the contents of the green channel, the green channel with the contents of the blue channel and the blue channel with the contents of the red channel.

To apply a mixing matrix, form the dot product with the image data.

A sequence of mixing matrices may be generated as follows:

mmList = Table[MatrixPower[N[base], j/20], {j, 0, 60}];

The full problem I wish to address is how to use ribbons to describe sequences of mixture matrix.

I have found it convenient to split the problem into the definition of two main functions. Also, my solution uses slots (#) in multiple layers and I don't know how to do this all in one go.

Each mixing matrix consists of 3 RGB colours. The first function produces a graphics object describing a single band derived from a single mixing matrix using the method described by @lukas. This constructs a 3-colour band then wraps the band with a single tooltip. I only want one tooltip per band.

bandG[rgb_, info_, ix_ : 1] := 
 Tooltip[MapThread[{RGBColor@#1, Rectangle@{ix, #2}} &, {rgb, {3, 2, 
     1}}], info]

To show this:

Graphics[bandG[base, "tricolour"], ImageSize -> {20, 30}]

enter image description here

To generate the ribbon, this just needs to be applied to the list of mixture matrices:

bandListG[rgbList_, infoList_] := 
 MapThread[
  bandG[#1, #2, #3] &, {rgbList, infoList, Range@Length@rgbList}]

To show the graphic:

Graphics[bandListG[mmList, MatrixForm /@ mmList], 
 ImageSize -> {600, 35}, AspectRatio -> Full]

enter image description here

When implemented in Mathematica, the ribbon shows the mixing matrix for each band when the mouse hovers over it; a little more work enables the matrix to be exported to, e.g. the clipboard at the click of a mouse.

The above takes about 1 ms on my computer which is a huge improvement over my original code.

$\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.