I would love to know if building something like this is possible is RShiny. I have experience with interactive plots/charts using plotly, ggplot and ggplotly but I can't see how to do something like this. I love how the graph engages the user to make a guess and then shows the real data.
If anyone could please point me in the direction of any documentation I will be forever grateful! https://www.mathematica-mpr.com/dataviz/race-to-the-top
Here is a Shiny implementation of this jsfiddle.
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)
The file barchartBinding.js, to put in the www subfolder of the app file:
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);
And below is a Shiny implementation of the amcharts4 grouped bar chart.
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)
The file groupedBarChartBinding.js, to put in the www subfolder:
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);
I have done a package now : shinyAmBarCharts. I have added a button (optional) allowing to update the data to another dataset. This fulfills the OP's desideratum:
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)
