6
$\begingroup$

I'm sure I've seen this sort of thing done before, but now I can't find a working implementation anywhere.

Below I give a toy example that is just complex enough to illustrate the issues. (I provide full code after the problem's description.)


First, consider this simple (and entirely meaningless) barchart:

In[122]:= With[
 {
   labels = BlockRandom[SeedRandom[-2];
               RandomSample[DictionaryLookup[{"English", ___}], nItems]
            ]
 },
 Framed[
  BarChart[data, ChartLabels -> labels
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImageSize -> 250
   ]
  , FrameStyle -> Thin
  ]
]

Mathematica graphics

The goal is to replace the text labels along the left with Graphic objects, ("graphic labels", if you will), in such a way that these labels scale appropriately with the figure.


For this (rather artificial!) example, the "graphic labels" I have in mind consist of several colored Rectangle objects lined up in a row, like this:

Mathematica graphics

(The black dot just marks the point (0, 0) in the barcode's internal reference frame; it is not part of the barcode.)

I defined a barcode function that, for any integer argument, generates a (random-but-reproducible) "barcode" like the one above.

Now, if I substitute such graphic labels for the text ones in the barchart, this is what I get:

In[124]:= With[
 {
   labels = Table[Graphics[barcode[i]], {i, Length[data]}]
 },
 Framed[
  BarChart[data, ChartLabels -> labels
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImageSize -> 250
   ]
  , FrameStyle -> Thin
  ]
]

Mathematica graphics

Not great. For one thing, the barcodes come out too big, and too far from the vertical axis.

But most seriously, the size of the barcodes does not change when ImageSize changes. For example, if ImageSize is changed from 250 to 500, the result looks like this:

Mathematica graphics

Confusingly enough, even though the size of the barcodes remains constant, the spacing between them changes in proportion to the change in ImageSize.


I'm looking for a way to set the size of the barcodes so that

  1. the height of the barcode corresponds to 1 plot unit (or slightly less), while preserving the barcode's original aspect ratio;
  2. the spacing between the barcodes and the (vertical) axis matches that between text labels and the axis;
  3. both the size of the barcode and the spacing between one barcode and the next one, and between the barcodes and axis scale with the image; (needless to say, the barcodes should always be fully visible irrespective of image size).

With enough trial-and-error, I can find a "solution" that meets requirements (1) and (2) (see under the Best so far heading further below), but I have not been able to find one that also meets requirement (3).

The next section includes all the code referenced above; the last section documents some failed attempts at solving the problem.


Code

nItems = 10;
data = BlockRandom[SeedRandom[-1];
   20 + RandomInteger[80, nItems]
];

With[{
  labels = BlockRandom[SeedRandom[-2];
    RandomSample[DictionaryLookup[{"English", ___}], nItems]
    ]
  },
 Framed[
  BarChart[data, ChartLabels -> labels
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImageSize -> 250
   ]
  , FrameStyle -> Thin
  ]
 ]

palette = ColorData[1, "ColorList"];
basewidth = 0.5;
baseheight = 1;
nstrips = 8;
baserect = Rectangle[{0, 0}, {basewidth, baseheight}];
barcode[index_] := BlockRandom[
  SeedRandom[index];
  Module[{colors = RandomSample[palette, nstrips]},
   Table[Translate[{colors[[i]], 
      baserect}, {(i - nstrips - 1) basewidth, -0.5 baseheight}], {i, 
     nstrips}]
   ]
  ]

Graphics[{barcode[1], Disk[{0, 0}, 0.05]}, Frame -> True, ImageSize -> Medium]

With[{
  labels = Table[Graphics[barcode[i]], {i, Length[data]}]
  },
 Framed[
  BarChart[data, ChartLabels -> labels
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImageSize -> 250
   ]
  , FrameStyle -> Thin
  ]
 ]

With[{
   labels = Table[Graphics[barcode[i]], {i, Length[data]}]
 },
 Framed[
  BarChart[data, ChartLabels -> labels
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImageSize -> 500
   ]
  , FrameStyle -> Thin
  ]
 ]

Failures

Best so far

Module[{
  FUDGEFACTOR = <|"insetMultiplier" -> 200, "leftPadding" -> 40|>
  , n
  , makeInset
  },
 ; n = Length[data]
 ; makeInset[i_] := Inset[Graphics[barcode[i]]
   , Scaled[{-0.02, 0}, {0, i}]
   , {0, 0}
   , FUDGEFACTOR["insetMultiplier"]/n
   ]
 ; Framed[
  BarChart[data, ChartLabels -> None
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImagePadding -> {{FUDGEFACTOR["leftPadding"], Automatic},
                      {Automatic, Automatic}}
   , ImageSize -> 250
   , Epilog -> Table[makeInset[i], {i, n}]
   ]
  , FrameStyle -> Thin
  ]
 ]

Mathematica graphics

  • scheme requires fudge-factors that must be determined by trial-and-error;
  • padding to make room for the barcodes does not scale appropriately when image is resized.

Using Scaled

Block[{baserect = 
   Rectangle[Scaled[{0, 0}], Scaled[{basewidth, baseheight}]]},
 With[{
   labels = Table[Graphics[barcode[i]], {i, Length[data]}]
   },
  Framed[
   BarChart[data, ChartLabels -> labels
    , ChartStyle -> LightGray
    , BarOrigin -> Left
    , ImageSize -> 250
    ]
   , FrameStyle -> Thin
   ]
  ]
 ]

Mathematica graphics

  • swatches within barcode overlap
  • overall scaling is wrong
  • positioning is wrong

Drawing labels in plot-space

With[{
  labels = 
   Table[Graphics[Translate[barcode[i], {0, i}]], {i, Length[data]}]
  },
 Framed[
  Show[{
    BarChart[data, ChartLabels -> None
     , ChartStyle -> LightGray
     , BarOrigin -> Left
     , ImageSize -> 250
     ],
    labels
    }
   ]
  , FrameStyle -> Thin
  ]
 ]

Mathematica graphics

  • aspect ratio is wrong

Using Inset

With[{
  labels = 
   Graphics[Table[Translate[barcode[i], {0, i}], {i, Length[data]}]]
  },
 Framed[
  BarChart[data, ChartLabels -> None
   , ChartStyle -> LightGray
   , BarOrigin -> Left
   , ImageSize -> 250
   , ImagePadding -> {{50, Automatic}, {120, Automatic}}
   , Epilog -> Inset[labels, {0, 0}]
   ]
  , FrameStyle -> Thin
  ]
 ]

Mathematica graphics

  • overall scaling is wrong
$\endgroup$
  • 1
    $\begingroup$ Have you tried using the additional parameters for Inset? e.g Inset[labels, Scaled[{-0.05, 0}], Scaled[{1, 0}], Scaled[1]] $\endgroup$ – Simon Woods Feb 8 '17 at 22:16
6
+50
$\begingroup$

I modified my previous answer to work better with datasets of different length. I rely on the AspectRatio being GoldenRatio. If it isn't, replace GoldenRatio with the appropriate AspectRatio. I also use 3.6 as the width to height ratio of the barcode.

edited to paint over axis below barcodes

makeInset[i_,n_] := Inset[
    Graphics[barcode[i]],
    Scaled[{-0.02,0},{0,i}],
    {0,0},
    Scaled[{3.6,1}/n]
];

bplot[data_] := With[{n = Length[data]},
    Framed[
        BarChart[
                data,
                ChartLabels->None,
                ChartStyle->LightGray,
                BarOrigin->Left,
                PlotRangePadding->{{Scaled[3.6 / (n*GoldenRatio)],0},{0,0}},
                ImageSize->250,
                Epilog->{
                    White,
                    Rectangle[Scaled[{-1,-1}, {0, 0}], Scaled[{-.02, 1}, {0, 0}]],
                    Table[makeInset[i,n],{i,n}]
                }
            ],
        FrameStyle->Thin
    ]
]

A couple examples:

bplot[data]

enter image description here

bplot[data[[;;5]]]

enter image description here

The basic idea is to use a scaled inset size, and then increase the PlotRangePadding to accommodate the addition of the barcodes.

$\endgroup$
  • $\begingroup$ Thank you, but the x-axis in your proposed solution incorrectly extends into negative values. Please the heading Best so far for what the desired solution looks like. $\endgroup$ – kjo Feb 10 '17 at 21:12
  • 1
    $\begingroup$ You can always paint over the axis by using something like: Epilog->{White, Rectangle[Scaled[{-1,-1}, {0, 0}], Scaled[{-.02, 1}, {0, 0}]],Table[makeInset[i,n],{i,n}]} $\endgroup$ – Carl Woll Feb 10 '17 at 21:38
  • $\begingroup$ @kjo It would be useful to explain what you didn't like about my answer so that it could have been improved further. As far as I can tell, my answer met all of your requirements. $\endgroup$ – Carl Woll Feb 17 '17 at 19:39
  • $\begingroup$ No problem with it. (I was holding out for an answer that did not require painting over the axis.) $\endgroup$ – kjo Feb 18 '17 at 1:30
  • 1
    $\begingroup$ That's possible, although I think it requires postprocessing the graphic to remove the undesirable ticks, make the axis transparent, and place a line of the desired length over the transparent axis. $\endgroup$ – Carl Woll Feb 18 '17 at 1:44

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.