r - 可拖动交互式条形图 R Shiny

Question

我很想知道 RShiny 是否可以构建这样的东西。我有使用 plotly、ggplot 和 ggplotly 制作交互式绘图/图表的经验，但我不知道如何做这样的事情。我喜欢图表如何吸引用户进行猜测，然后显示真实数据。

如果有人可以请指出任何文档的方向，我将永远感激!
https://www.mathematica-mpr.com/dataviz/race-to-the-top

Answer 1

这是 this jsfiddle 的 Shiny 实现.

library(shiny)
library(jsonlite)

barChartInput <- function(inputId, width = "100%", height = "400px", 
                          data, category, value, minValue, maxValue, 
                          color = "rgb(208,32,144)"){
  tags$div(id = inputId, class = "amchart", 
           style = sprintf("width: %s; height: %s;", width, height),
           `data-data` = as.character(toJSON(data)),
           `data-category` = category, 
           `data-value` = value,
           `data-min` = minValue,
           `data-max` = maxValue,
           `data-color` = color)
}

dat <- data.frame(
  country = c("USA", "China", "Japan", "Germany", "UK", "France"),
  visits = c(3025, 1882, 1809, 1322, 1122, 1114)
)

ui <- fluidPage(
  tags$head(
    tags$script(src = "http://www.amcharts.com/lib/4/core.js"),
    tags$script(src = "http://www.amcharts.com/lib/4/charts.js"),
    tags$script(src = "http://www.amcharts.com/lib/4/themes/animated.js"),
    tags$script(src = "barchartBinding.js")
  ),
  fluidRow(
    column(8, 
           barChartInput("mybarchart", data = dat, 
                         category = "country", value = "visits",
                         minValue = 0, maxValue = 3500)),
    column(4, 
           tags$label("Data:"),
           verbatimTextOutput("data"), 
           br(),
           tags$label("Change:"),
           verbatimTextOutput("change"))
  )
)

server <- function(input, output){

  output[["data"]] <- renderPrint({ 
    if(is.null(input[["mybarchart"]])){
      dat
    }else{
      fromJSON(input[["mybarchart"]]) 
    }
  })

  output[["change"]] <- renderPrint({ input[["mybarchart_change"]] })

}

shinyApp(ui, server)

文件 barchartBinding.js , 放入 www 应用程序文件的子文件夹:

var barchartBinding = new Shiny.InputBinding();

$.extend(barchartBinding, {
    find: function (scope) {
      return $(scope).find(".amchart");
    },
    getValue: function (el) {
      return null;
    },
    subscribe: function (el, callback) {
      $(el).on("change.barchartBinding", function (e) {
        callback();
      });
    },
    unsubscribe: function (el) {
      $(el).off(".barchartBinding");
    },
    initialize: function (el) {

      var id = el.getAttribute("id");
      var $el = $(el);
      var data = $el.data("data");
      var dataCopy = $el.data("data");
      var categoryName = $el.data("category");
      var valueName = $el.data("value");
      var minValue = $el.data("min");
      var maxValue = $el.data("max");
      var barColor = $el.data("color");

      am4core.useTheme(am4themes_animated);

      var chart = am4core.create(id, am4charts.XYChart);
      chart.hiddenState.properties.opacity = 0; // this makes initial fade in effect

      chart.data = data;

      chart.padding(40, 40, 0, 0);
      chart.maskBullets = false; // allow bullets to go out of plot area

      var text = chart.plotContainer.createChild(am4core.Label);
      text.text = "Drag column bullet to change its value";
      text.y = 92;
      text.x = am4core.percent(100);
      text.horizontalCenter = "right";
      text.zIndex = 100;
      text.fillOpacity = 0.7;

      // category axis
      var categoryAxis = chart.xAxes.push(new am4charts.CategoryAxis());
      categoryAxis.title.text = categoryName;
      categoryAxis.title.fontWeight = "bold";
      categoryAxis.dataFields.category = categoryName;
      categoryAxis.renderer.grid.template.disabled = true;
      categoryAxis.renderer.minGridDistance = 50;

      // value axis
      var valueAxis = chart.yAxes.push(new am4charts.ValueAxis());
      valueAxis.title.text = valueName;
      valueAxis.title.fontWeight = "bold";
      // we set fixed min/max and strictMinMax to true, as otherwise value axis will adjust min/max while dragging and it won't look smooth
      valueAxis.strictMinMax = true;
      valueAxis.min = minValue;
      valueAxis.max = maxValue;
      valueAxis.renderer.minWidth = 60;

      // series
      var series = chart.series.push(new am4charts.ColumnSeries());
      series.dataFields.categoryX = categoryName;
      series.dataFields.valueY = valueName;
      series.tooltip.pointerOrientation = "vertical";
      series.tooltip.dy = -8;
      series.sequencedInterpolation = true;
      series.defaultState.interpolationDuration = 1500;
      series.columns.template.strokeOpacity = 0;

      // label bullet
      var labelBullet = new am4charts.LabelBullet();
      series.bullets.push(labelBullet);
      labelBullet.label.text = "{valueY.value.formatNumber('#.')}";
      labelBullet.strokeOpacity = 0;
      labelBullet.stroke = am4core.color("#dadada");
      labelBullet.dy = -20;

      // series bullet
      var bullet = series.bullets.create();
      bullet.stroke = am4core.color("#ffffff");
      bullet.strokeWidth = 3;
      bullet.opacity = 0; // initially invisible
      bullet.defaultState.properties.opacity = 0;
      // resize cursor when over
      bullet.cursorOverStyle = am4core.MouseCursorStyle.verticalResize;
      bullet.draggable = true;

      // create hover state
      var hoverState = bullet.states.create("hover");
      hoverState.properties.opacity = 1; // visible when hovered

      // add circle sprite to bullet
      var circle = bullet.createChild(am4core.Circle);
      circle.radius = 8;

      // while dragging
      bullet.events.on("drag", event => {
        handleDrag(event);
      });

      bullet.events.on("dragstop", event => {
        handleDrag(event);
        var dataItem = event.target.dataItem;
        dataItem.column.isHover = false;
        event.target.isHover = false;
        dataCopy[dataItem.index][valueName] = dataItem.values.valueY.value;
        Shiny.setInputValue(id, JSON.stringify(dataCopy));
        Shiny.setInputValue(id + "_change", {
          index: dataItem.index,
          category: dataItem.categoryX, 
          value: dataItem.values.valueY.value
        });
      });

      function handleDrag(event) {
        var dataItem = event.target.dataItem;
        // convert coordinate to value
        var value = valueAxis.yToValue(event.target.pixelY);
        // set new value
        dataItem.valueY = value;
        // make column hover
        dataItem.column.isHover = true;
        // hide tooltip not to interrupt
        dataItem.column.hideTooltip(0);
        // make bullet hovered (as it might hide if mouse moves away)
        event.target.isHover = true;
      }

      // column template
      var columnTemplate = series.columns.template;
      columnTemplate.column.cornerRadiusTopLeft = 8;
      columnTemplate.column.cornerRadiusTopRight = 8;
      columnTemplate.fillOpacity = 0.8;
      columnTemplate.tooltipText = "drag me";
      columnTemplate.tooltipY = 0; // otherwise will point to middle of the column

      // hover state
      var columnHoverState = columnTemplate.column.states.create("hover");
      columnHoverState.properties.fillOpacity = 1;
      // you can change any property on hover state and it will be animated
      columnHoverState.properties.cornerRadiusTopLeft = 35;
      columnHoverState.properties.cornerRadiusTopRight = 35;

      // show bullet when hovered
      columnTemplate.events.on("over", event => {
        var dataItem = event.target.dataItem;
        var itemBullet = dataItem.bullets.getKey(bullet.uid);
        itemBullet.isHover = true;
      });

      // hide bullet when mouse is out
      columnTemplate.events.on("out", event => {
        var dataItem = event.target.dataItem;
        var itemBullet = dataItem.bullets.getKey(bullet.uid);
        itemBullet.isHover = false;
      });

      // start dragging bullet even if we hit on column not just a bullet, this will make it more friendly for touch devices
      columnTemplate.events.on("down", event => {
        var dataItem = event.target.dataItem;
        var itemBullet = dataItem.bullets.getKey(bullet.uid);
        itemBullet.dragStart(event.pointer);
      });

      // when columns position changes, adjust minX/maxX of bullets so that we could only dragg vertically
      columnTemplate.events.on("positionchanged", event => {
        var dataItem = event.target.dataItem;
        var itemBullet = dataItem.bullets.getKey(bullet.uid);
        var column = dataItem.column;
        itemBullet.minX = column.pixelX + column.pixelWidth / 2;
        itemBullet.maxX = itemBullet.minX;
        itemBullet.minY = 0;
        itemBullet.maxY = chart.seriesContainer.pixelHeight;
      });

      // as by default columns of the same series are of the same color, we add adapter which takes colors from chart.colors color set
      columnTemplate.adapter.add("fill", (fill, target) => {
        return barColor; //chart.colors.getIndex(target.dataItem.index).saturate(0.3);
      });

      bullet.adapter.add("fill", (fill, target) => {
        return chart.colors.getIndex(target.dataItem.index).saturate(0.3);
      });

    }
});

Shiny.inputBindings.register(barchartBinding);

更新

下面是 amcharts4 分组条形图的 Shiny 实现。

library(shiny)
library(jsonlite)

registerInputHandler("dataframe", function(data, ...) {
  fromJSON(toJSON(data, auto_unbox = TRUE))
}, force = TRUE)

groupedBarChartInput <- function(inputId, width = "100%", height = "400px", 
                                 data, categoryField, valueFields, 
                                 minValue, maxValue, 
                                 ndecimals = 0, 
                                 colors = NULL, 
                                 categoryLabel = categoryField, 
                                 valueLabels = valueFields, 
                                 categoryAxisTitle = categoryLabel,
                                 valueAxisTitle = NULL,
                                 categoryAxisTitleFontSize = 22,
                                 valueAxisTitleFontSize = 22,
                                 categoryAxisTitleColor = "indigo",
                                 valueAxisTitleColor = "indigo",
                                 draggable = rep(FALSE, length(valueFields))){
  tags$div(id = inputId, class = "amGroupedBarChart", 
           style = sprintf("width: %s; height: %s;", width, height),
           `data-data` = as.character(toJSON(data)),
           `data-categoryfield` = categoryField, 
           `data-valuefields` = as.character(toJSON(valueFields)),
           `data-min` = minValue,
           `data-max` = maxValue,
           `data-ndecimals` = ndecimals,
           `data-colors` = ifelse(is.null(colors), "auto", as.character(toJSON(colors))),
           `data-valuenames` = as.character(toJSON(valueLabels)),
           `data-categoryname` = categoryLabel,
           `data-categoryaxistitle` = categoryAxisTitle,
           `data-valueaxistitle` = valueAxisTitle,
           `data-draggable` = as.character(toJSON(draggable)),
           `data-categoryaxistitlefontsize` = categoryAxisTitleFontSize,
           `data-valueaxistitlefontsize` = valueAxisTitleFontSize,
           `data-categoryaxistitlecolor` = categoryAxisTitleColor,
           `data-valueaxistitlecolor` = valueAxisTitleColor)
}

set.seed(666)
dat <- data.frame(
  year = rpois(5, 2010),
  income = rpois(5, 25),
  expenses = rpois(5, 20)
)

ui <- fluidPage(
  tags$head(
    tags$script(src = "http://www.amcharts.com/lib/4/core.js"),
    tags$script(src = "http://www.amcharts.com/lib/4/charts.js"),
    tags$script(src = "http://www.amcharts.com/lib/4/themes/animated.js"),
    tags$script(src = "groupedBarChartBinding.js")
  ),
  fluidRow(
    column(8, 
           groupedBarChartInput("mybarchart", data = dat[order(dat$year),], 
                                categoryField = "year", 
                                valueFields = c("income", "expenses"),
                                categoryLabel = "Year", 
                                valueLabels =  c("Income", "Expenses"),
                                valueAxisTitle = "Income and expenses",
                                minValue = 0, maxValue = 35, 
                                draggable = c(FALSE, TRUE),
                                colors = c("darkmagenta","darkred"))),
    column(4, 
           tags$label("Data:"),
           verbatimTextOutput("data"), 
           br(),
           tags$label("Change:"),
           verbatimTextOutput("change"))
  )
)

server <- function(input, output){

  output[["data"]] <- renderPrint({ 
    input[["mybarchart"]] 
  })

  output[["change"]] <- renderPrint({ input[["mybarchart_change"]] })

}

shinyApp(ui, server)

文件 groupedBarChartBinding.js , 放入 www 子文件夹:

var groupedBarChartBinding = new Shiny.InputBinding();

$.extend(groupedBarChartBinding, {
    find: function(scope) {
        return $(scope).find(".amGroupedBarChart");
    },
    getValue: function(el) {
        return $(el).data("data");
    },
    getType: function(el) {
        return "dataframe";
    },
    subscribe: function(el, callback) {
        $(el).on("change.groupedBarChartBinding", function(e) {
            callback();
        });
    },
    unsubscribe: function(el) {
        $(el).off(".groupedBarChartBinding");
    },
    initialize: function(el) {

        var id = el.getAttribute("id");
        var $el = $(el);
        var data = $el.data("data");
        var dataCopy = $el.data("data");
        var categoryField = $el.data("categoryfield");
        var valueFields = $el.data("valuefields");
        var minValue = $el.data("min");
        var maxValue = $el.data("max");
        var colors = $el.data("colors");
        var valueNames = $el.data("valuenames");
        var categoryName = $el.data("categoryname");
        var categoryAxisTitle = $el.data("categoryaxistitle");
        var valueAxisTitle = $el.data("valueaxistitle");
        var draggable = $el.data("draggable");
        var ndecimals = $el.data("ndecimals");
        var numberFormat = "#.";
        for (var i = 0; i < ndecimals; i++) {
            numberFormat = numberFormat + "#";
        }
        var categoryAxisTitleFontSize = $el.data("categoryaxistitlefontsize") + "px";
        var valueAxisTitleFontSize = $el.data("valueaxistitlefontsize") + "px";
        var categoryAxisTitleColor = $el.data("categoryaxistitlecolor");
        var valueAxisTitleColor = $el.data("valueaxistitlecolor");

        am4core.useTheme(am4themes_animated);

        var chart = am4core.create(id, am4charts.XYChart);
        chart.hiddenState.properties.opacity = 0; // this makes initial fade in effect

        chart.data = data;

        chart.padding(40, 40, 40, 40);
        chart.maskBullets = false; // allow bullets to go out of plot area

        // Create axes
        var categoryAxis = chart.yAxes.push(new am4charts.CategoryAxis());
        categoryAxis.dataFields.category = categoryField;
        categoryAxis.numberFormatter.numberFormat = numberFormat;
        categoryAxis.renderer.inversed = true;
        categoryAxis.renderer.grid.template.location = 0;
        categoryAxis.renderer.cellStartLocation = 0.1;
        categoryAxis.renderer.cellEndLocation = 0.9;
        categoryAxis.title.text = categoryAxisTitle;
        categoryAxis.title.fontWeight = "bold";
        categoryAxis.title.fontSize = categoryAxisTitleFontSize;
        categoryAxis.title.setFill(categoryAxisTitleColor);

        var valueAxis = chart.xAxes.push(new am4charts.ValueAxis());
        valueAxis.renderer.opposite = true;
        valueAxis.strictMinMax = true;
        valueAxis.min = minValue;
        valueAxis.max = maxValue;
        if (valueAxisTitle !== null) {
            valueAxis.title.text = valueAxisTitle;
            valueAxis.title.fontWeight = "bold";
            valueAxis.title.fontSize = valueAxisTitleFontSize;
            valueAxis.title.setFill(valueAxisTitleColor);
        }

        function handleDrag(event) {
            var dataItem = event.target.dataItem;
            // convert coordinate to value
            var value = valueAxis.xToValue(event.target.pixelX);
            // set new value
            dataItem.valueX = value;
            // make column hover
            dataItem.column.isHover = true;
            // hide tooltip not to interrupt
            dataItem.column.hideTooltip(0);
            // make bullet hovered (as it might hide if mouse moves away)
            event.target.isHover = true;
        }

        // Create series
        function createSeries(field, name, barColor, drag) {
            var series = chart.series.push(new am4charts.ColumnSeries());
            series.dataFields.valueX = field;
            series.dataFields.categoryY = categoryField;
            series.name = name;
            series.sequencedInterpolation = true;

            var valueLabel = series.bullets.push(new am4charts.LabelBullet());
            valueLabel.label.text = "{valueX}";
            valueLabel.label.horizontalCenter = "left";
            valueLabel.label.dx = 10;
            valueLabel.label.hideOversized = false;
            valueLabel.label.truncate = false;

            var categoryLabel = series.bullets.push(new am4charts.LabelBullet());
            categoryLabel.label.text = "{name}";
            categoryLabel.label.horizontalCenter = "right";
            categoryLabel.label.dx = -10;
            categoryLabel.label.fill = am4core.color("#fff");
            categoryLabel.label.hideOversized = false;
            categoryLabel.label.truncate = false;

            // column template
            var columnTemplate = series.columns.template;
            console.log(columnTemplate);
            //  columnTemplate.tooltipText = "{name}: [bold]{valueX}[/]";
            columnTemplate.tooltipHTML =
                "<div style='font-size:9px'>" + "{name}" + ": " + "<b>{valueX}</b>" + "</div>";
            columnTemplate.height = am4core.percent(100);
            columnTemplate.column.cornerRadiusBottomRight = 8;
            columnTemplate.column.cornerRadiusTopRight = 8;
            columnTemplate.fillOpacity = 1;
            columnTemplate.tooltipX = 0; // otherwise will point to middle of the column
            // hover state
            var columnHoverState = columnTemplate.column.states.create("hover");
            columnHoverState.properties.fillOpacity = 1;
            // you can change any property on hover state and it will be animated
            columnHoverState.properties.cornerRadiusBottomRight = 35;
            columnHoverState.properties.cornerRadiusTopRight = 35;
            // color
            if (barColor !== false) {
                columnTemplate.adapter.add("fill", (fill, target) => {
                    return barColor;
                });
            }


            if (drag) {
                // series bullet
                var bullet = series.bullets.create();
                bullet.stroke = am4core.color("#ffffff");
                bullet.strokeWidth = 1;
                bullet.opacity = 0; // initially invisible
                bullet.defaultState.properties.opacity = 0;
                // resize cursor when over
                bullet.cursorOverStyle = am4core.MouseCursorStyle.horizontalResize;
                bullet.draggable = true;
                // create hover state
                var hoverState = bullet.states.create("hover");
                hoverState.properties.opacity = 1; // visible when hovered
                // add circle sprite to bullet
                var circle = bullet.createChild(am4core.Circle);
                circle.radius = 5;
                // dragging
                // while dragging
                bullet.events.on("drag", event => {
                    handleDrag(event);
                });
                bullet.events.on("dragstop", event => {
                    handleDrag(event);
                    var dataItem = event.target.dataItem;
                    dataItem.column.isHover = false;
                    event.target.isHover = false;
                    dataCopy[dataItem.index][field] = dataItem.values.valueX.value;
                    Shiny.setInputValue(id + ":dataframe", dataCopy);
                    Shiny.setInputValue(id + "_change", {
                        index: dataItem.index,
                        field: field,
                        category: dataItem.categoryY,
                        value: dataItem.values.valueX.value
                    });
                });
                // bullet color
                if (barColor !== false) {
                    bullet.adapter.add("fill", (fill, target) => {
                        return barColor;
                    });
                }
                // show bullet when hovered
                columnTemplate.events.on("over", event => {
                    var dataItem = event.target.dataItem;
                    var itemBullet = dataItem.bullets.getKey(bullet.uid);
                    itemBullet.isHover = true;
                });
                // hide bullet when mouse is out
                columnTemplate.events.on("out", event => {
                    var dataItem = event.target.dataItem;
                    var itemBullet = dataItem.bullets.getKey(bullet.uid);
                    itemBullet.isHover = false;
                });
                // start dragging bullet even if we hit on column not just a bullet, this will make it more friendly for touch devices
                columnTemplate.events.on("down", event => {
                    var dataItem = event.target.dataItem;
                    var itemBullet = dataItem.bullets.getKey(bullet.uid);
                    itemBullet.dragStart(event.pointer);
                });
                // when columns position changes, adjust minY/maxY of bullets so that we could only dragg horizontally
                columnTemplate.events.on("positionchanged", event => {
                    var dataItem = event.target.dataItem;
                    var itemBullet = dataItem.bullets.getKey(bullet.uid);
                    var column = dataItem.column;
                    itemBullet.minY = column.pixelY + column.pixelHeight / 2;
                    itemBullet.maxY = itemBullet.minY;
                    itemBullet.minX = 0;
                    itemBullet.maxX = chart.seriesContainer.pixelWidth;
                });
            }
        }

        for (var i = 0; i < valueFields.length; i++) {
            var color = colors === "auto" ? null : colors[i];
            createSeries(valueFields[i], valueNames[i], color, draggable[i]);
        }

    }
});

Shiny.inputBindings.register(groupedBarChartBinding);

更新 2

我现在做了一个包裹: shinyAmBarCharts .我添加了一个按钮(可选)，允许将数据更新到另一个数据集。这满足了 OP 的要求:

the graph engages the user to make a guess and then shows the real data

library(shiny)
library(shinyAmBarCharts)

# create a dataset
set.seed(666)
df0 <- data.frame(
  species = rep(c("sorgho","poacee","banana"), each = 3),
  condition = rep(c("normal", "stress", "Nitrogen"), 3),
  value = rpois(9, 10)
)
df1 <- df0; df1[["value"]] <- 10
dat <- tidyr::spread(df0, condition, value)  # true data
dat2 <- tidyr::spread(df1, condition, value) # data template

# grouped bar chart
ui <- fluidPage(

  br(),

  fluidRow(
    column(9,
           amBarChart(
             "mygroupedbarchart", data = dat2, data2 = dat, height = "400px",
             category = "species", value = c("normal", "stress", "Nitrogen"),
             valueNames = c("Normal", "Stress", "Nitrogen"),
             minValue = 0, maxValue = 20,
             draggable = c(TRUE, TRUE, TRUE),
             theme = "dark", backgroundColor = "#30303d",
             columnStyle = list(fill = c("darkmagenta", "darkred", "gold"),
                                stroke = "#cccccc", 
                                cornerRadius = 4),
             chartTitle = list(text = "Grouped bar chart", 
                               fontSize = 23, 
                               color = "firebrick"),
             xAxis = list(title = list(text = "Species", 
                                       fontSize = 21, 
                                       color = "silver"),
                          labels = list(color = "whitesmoke", 
                                        fontSize = 17)),
             yAxis = list(title = list(text = "Value", 
                                       fontSize = 21, 
                                       color = "silver"),
                          labels = list(color = "whitesmoke", 
                                        fontSize = 14)),
             columnWidth = 90,
             button = list(text = "Show true data"),
             caption = list(text = "[font-style:italic]shinyAmBarCharts[/]", 
                            color = "yellow"),
             gridLines = list(color = "whitesmoke", 
                              opacity = 0.4, 
                              width = 1),
             tooltip = list(text = "[bold;font-style:italic]{name}: {valueY}[/]", 
                            labelColor = "#101010", 
                            backgroundColor = "cyan", 
                            backgroundOpacity = 0.7)
           )
    ),
    column(3,
           tags$label("Data:"),
           verbatimTextOutput("data"),
           br(),
           tags$label("Change:"),
           verbatimTextOutput("change"))
  )

)

server <- function(input, output){

  output[["data"]] <- renderPrint({
    input[["mygroupedbarchart"]]
  })

  output[["change"]] <- renderPrint({ input[["mygroupedbarchart_change"]] })

}

shinyApp(ui, server)