Hi everyone, not an expert here. maybe someone can help: How do I make the Deficit flow start below/aligned with Budgetary revenues. All my flows are starting at the beginning.
I tried custom_positions <- tibble::tribble( ~name, ~x, ~y, "Deficit", 0.6, 0.5), but it's not working. Here is my code.
Packages
pkgs <- c("dplyr", "tidyr", "tibble", "networkD3", "htmlwidgets")
to_install <- setdiff(pkgs, rownames(installed.packages()))
if (length(to_install)) install.packages(to_install)
lapply(pkgs, library, character.only = TRUE)
Data
flows <- tibble::tribble(
~source, ~value, ~target, ~hex,
"Personal income tax", 214, "Income taxes", "#02205F",
"Corporate income tax", 86, "Income taxes", "#02205F",
"Non-resident income tax", 13, "Income taxes", "#02205F",
"Goods and Services Tax", 51, "Excise taxes/duties", "#67799F",
"Custom imports duties", 7, "Excise taxes/duties", "#67799F",
"Other taxes/duties", 12, "Excise taxes/duties", "#67799F",
"Income taxes", 313, "Budgetary revenues", "#76BDD9",
"Excise taxes/duties", 70, "Budgetary revenues", "#98CEE2",
"EI premium revenues", 28, "Budgetary revenues", "#BADEEC",
"Pollution pricing", 10, "Budgetary revenues", "#BADEEC",
"Enterprise Crown corporation", 6, "Budgetary revenues", "#BADEEC",
"Other programs", 27, "Budgetary revenues", "#BADEEC",
"Net foreign exchange", 3, "Budgetary revenues", "#BADEEC",
"Budgetary revenues", 457, "Budgetary expenses", "#7E7E7F",
"Deficit", 40, "Budgetary expenses", "#7E7E7F",
"Budgetary expenses", 6, "Actuarial loss", "#FFC000",
"Budgetary expenses", 44, "Public Debt charges", "#FFC000",
"Budgetary expenses", 100, "Transfers to other government", "#FFC000",
"Budgetary expenses", 126, "Transfers to persons", "#FFC000",
"Budgetary expenses", 221, "Direct program expenses", "#FFC000",
"Transfers to other government", 53, "Health Transfers", "#FFE699",
"Transfers to other government", 16, "Social Transfers", "#FFE699",
"Transfers to other government", 24, "Equalization", "#FFE699",
"Transfers to other government", 5, "Territorial Formula Financing", "#FFE699",
"Transfers to other government", 6, "Child care", "#FFE699",
"Transfers to other government", 2, "Community-Building", "#FFE699",
"Transfers to persons", 24, "EI benefits", "#FFE699",
"Transfers to persons", 76, "Elderly benefits", "#FFE699",
"Transfers to persons", 26, "Canada Child Benefit", "#FFE699",
"Direct program expenses", 124, "Operating expense", "#FFE699",
"Direct program expenses", 86, "Other transfer payments", "#FFE699",
"Direct program expenses", 11, "Fuel charge proceeds return", "#FFE699"
)
Nodes
nodes <- tibble(name = unique(c(flows$source, flows$target)))
id_map <- setNames(seq_len(nrow(nodes)) - 1L, nodes$name)
links <- flows |>
mutate(
source = id_map[source],
target = id_map[target],
group = hex
)
Colors
node_colors <- flows |>
distinct(source, hex) |>
rename(name = source, group = hex) |>
right_join(nodes, by = "name") |>
mutate(group = ifelse(is.na(group), "#999999", group))
Scale
all_hex <- sort(unique(c(links$group, node_colors$group)))
colourScale <- paste0(
"d3.scaleOrdinal()",
".domain([", paste(sprintf("'%s'", all_hex), collapse = ","), "])",
".range([", paste(sprintf("'%s'", all_hex), collapse = ","), "])"
)
Sankey
p <- networkD3::sankeyNetwork(
Links = links,
Nodes = node_colors,
Source = "source",
Target = "target",
Value = "value",
NodeID = "name",
NodeGroup = "group",
LinkGroup = "group",
sinksRight = TRUE,
fontSize = 13,
nodeWidth = 24,
nodePadding = 18,
colourScale = colourScale
)
Hover
p <- htmlwidgets::onRender(
p,
"
function(el,x){
d3.select(el).selectAll('.link')
.style('stroke-opacity',0.35)
.on('mouseover', function(){ d3.select(this).style('stroke-opacity',0.6); })
.on('mouseout', function(){ d3.select(this).style('stroke-opacity',0.35); });
d3.select(el).selectAll('.node text').style('font-weight',600);
}"
)
#Display
p
htmlwidgets::saveWidget(p, 'budget_sankey1.html', selfcontained = TRUE)

