Compressing sparse bars

[helgasoft]

Sparse datasets could show exessive empty spaces in a bar chart. The issue has been repeatedly reported on ECharts (JS) and echarts4r (R) boards. A solution that consists of preprocessing data and creating a non-linear axis has recently surfaced. Here we share echarty code related to the subject. 1) Original sparse bar chart

tmp <- "
A, B, C,D
10,10,0,0
0, 7, 8,0
6, 9, 7,6"
df <- read.csv(text=tmp, header=T)

bars <- list(type='bar', seriesLayoutBy='row')
ec.init(df, 
  xAxis= list(type= 'category', name=''),
  yAxis= list(name=''),
  series= list(bars, bars, bars)
)

2) Compressed bars with the help of a JavaScript function

txt <- paste('const df=', df |> ec.init(preset=F) |> ec.inspect(), ';')
jsc <- "function noZero(allSeries) {  // adapted from https://codepen.io/kikon-do/pen/OJrEKBK
  const xAxisLabels = echarts.util.clone(allSeries[0]);
  allSeries.splice(0,1);
  colors =['#5470c6','#91cc75','#fac858'];
  const nDatasets = allSeries.length,
    nDataItems = xAxisLabels.length; 
  const seriesCombined = [],
    valuesForLabels = [],
    missingTicks = [],
    hiddenCategories = [], // categories that have no data
    hiddenDatasets = allSeries.flatMap((dataset, index) =>
      dataset.filter((v) => v).length === 0 ? index : []
    );

  let x = 0.5,
    currentLabelValue = 0,
    currentTickValue = 0,
    totalBars = 0;
  for (let dataItemIdx = 0; dataItemIdx < nDataItems; dataItemIdx++) {
    let nItemsForCategory = 0;
    allSeries.forEach(function (seriesData, groupIdx) {
      const val = seriesData[dataItemIdx];
      if (val) {
        seriesCombined.push({ value: val, x, group: groupIdx });
        x++;
        nItemsForCategory++;
        totalBars++;
      }
    });
    currentLabelValue += nItemsForCategory / 2;
    valuesForLabels.push(currentLabelValue);
    currentLabelValue += nItemsForCategory / 2;
    const nMissingTicks = nItemsForCategory - 1;
    missingTicks.push(
      ...Array.from(
        { length: nMissingTicks },
        (_, k) => currentTickValue + k + 1
      )
    );
    currentTickValue += nItemsForCategory;
    if (nItemsForCategory === 0) {
      hiddenCategories.push(dataItemIdx);
    }
  }

  return {
    dataset: [{ source: seriesCombined }],
    visualMap: [
      {
        type: 'piecewise',
        categories: Array.from({ length: nDatasets }, (_, i) =>
          hiddenDatasets.includes(i) ? null : i
        ).filter((x) => x !== null),
        inRange: {
          color: colors.filter((_, i) => !hiddenDatasets.includes(i))
        },
        top: 11,
        right: 10
      }
    ],
    xAxis: [
      {
        // first axis for labels, no tick marks
        type: 'value',
        max: x - 0.5,
        interval: 0.5,
        axisTick: {
          length: 0
        },
        splitLine: {
          show: false
        },
        axisLabel: {
          formatter(value) {
            const idx = valuesForLabels.indexOf(value);
            if (idx >= 0 && hiddenCategories.indexOf(idx) < 0) {
              return xAxisLabels[idx];
            }
            return '';
          },
          fontWeight: 'bold'
        }
      },
      {
        // a secondary axis for ticks only
        data: Array(totalBars).fill(''),
        type: 'category',
        position: 'bottom',
        axisTick: {
          interval(index) {
            if (missingTicks.indexOf(index) >= 0) {
              return false;
            }
            return true;
          },
          length: 8, lineStyle: { width: 3 }
        }
      }
    ],
    yAxis: [{ }],
    series: [{
        type: 'bar',
        encode: { x: 'x', y: 'value'},
    }]
  };
}"
txt <- paste(txt, jsc, 'opts= noZero(df.dataset[0].source); chart.setOption(opts);')
ec.init(js= txt)

3) As a preferable R solution we offer module trimZero() - part of the paid Extras collection. It is a (couple hours) translation of the above JS code to R.

tz <- trimZero(df)    # part of echarty Extras($)
ec.init(
  dataset= tz$dataset, 
  xAxis= tz$xAxis,
  series= list(list(type= 'bar', encode= list(x= 'x', y= 'value') )),
  visualMap= list(
    type= 'piecewise', top= 10, right= 10,
    categories= sort(unlist(unique(lapply(tz$dataset$source, \(x) x$group)))),
    inRange= list(color= c('blue','green','gold'))
  )
)