Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update: sankeyPlot() #21

Merged
merged 4 commits into from
Nov 2, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
199 changes: 122 additions & 77 deletions R/plot_sankey.R
Original file line number Diff line number Diff line change
Expand Up @@ -458,6 +458,9 @@ sankey_relation_pair = function(g, gsp, rel_idx, node_idx_start = 0) {
#' @param feat_type feature type of metadata
#' @param meta_type whether to use 'cell' (cell) or 'feat' (feature) metadata
#' @param idx table subset index for 1 to 1 comparisons
#' @param focus_names character vector of node names to display. Others will be
#' omitted.
#' @param unfocused_color whether to color nodes that are not focused on.
#' @inheritDotParams networkD3::sankeyNetwork -Links -Nodes -Source -Target -Value -NodeID
#' @examples
#' \dontrun{
Expand All @@ -479,6 +482,9 @@ sankey_relation_pair = function(g, gsp, rel_idx, node_idx_start = 0) {
#' # list: note that node "1" is now considered a different node between x and y
#' sankeyPlot(list(x,y), fontSize = 20)
#'
#' # focus on specific nodes/names
#' sankeyPlot(rbind(x,y), fontSize = 20, focus_names = c('a', '1', 'B'))
#'
#' g = GiottoData::loadGiottoMini("vizgen")
#' # with giottoSankeyPlan
#' leiden = sankeySet(spat_unit = 'aggregate',
Expand Down Expand Up @@ -509,6 +515,8 @@ setMethod(
function(x,
y,
meta_type = c('cell', 'feat'),
focus_names = NULL,
unfocused_color = FALSE,
...) {
GiottoUtils::package_check("networkD3")
meta_type = match.arg(meta_type, choices = c('cell', 'feat'))
Expand Down Expand Up @@ -546,6 +554,8 @@ setMethod(
Target = 'target',
Value = 'value',
NodeID = 'name',
focus_names = focus_names,
unfocused_color = unfocused_color,
...
)
}
Expand All @@ -565,6 +575,8 @@ setMethod(
feat_type = NULL,
meta_type = c('cell', 'feat'),
idx = NULL,
focus_names = NULL,
unfocused_color = FALSE,
...) {

GiottoUtils::package_check("networkD3")
Expand Down Expand Up @@ -617,6 +629,8 @@ setMethod(
Target = 'target',
Value = 'value',
NodeID = 'name',
focus_names = focus_names,
unfocused_color = unfocused_color,
...
)
}
Expand All @@ -625,86 +639,101 @@ setMethod(

#' @rdname sankeyPlot
#' @export
setMethod('sankeyPlot', signature(x = 'data.frame', y = 'missing'), function(x, ...) {
GiottoUtils::package_check("networkD3")

x = data.table::as.data.table(x)
res = sankey_compare(data_dt = x)
links_dt = res$links

# create nodes table
nodes = data.table::data.table(name = res$nodes)

sankey_networkd3(
Links = links_dt,
Nodes = nodes,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'name',
...
)
setMethod(
'sankeyPlot',
signature(x = 'data.frame', y = 'missing'),
function(x, focus_names = NULL, unfocused_color = FALSE, ...)
{
GiottoUtils::package_check("networkD3")

})
x = data.table::as.data.table(x)
res = sankey_compare(data_dt = x)
links_dt = res$links

# create nodes table
nodes = data.table::data.table(name = res$nodes)

sankey_networkd3(
Links = links_dt,
Nodes = nodes,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'name',
focus_names = focus_names,
unfocused_color = unfocused_color,
...
)

})

#' @rdname sankeyPlot
#' @export
setMethod('sankeyPlot', signature(x = 'list', y = 'missing'), function(x, ...) {
checkmate::assert_list(x, types = 'data.frame')
if (length(x) == 0L) stop('input is empty list')
setMethod(
'sankeyPlot',
signature(x = 'list', y = 'missing'),
function(x, focus_names = NULL, unfocused_color = FALSE, ...)
{
checkmate::assert_list(x, types = 'data.frame')
if (length(x) == 0L) stop('input is empty list')

# iterate through sankey relations in the list
node_idx_start = 0
links_dt = data.table::data.table()
nodes = c()
# iterate through sankey relations in the list
node_idx_start = 0
links_dt = data.table::data.table()
nodes = c()

for (dt_i in seq_along(x)) {
for (dt_i in seq_along(x)) {

rel_data = sankey_compare(
data_dt = data.table::as.data.table(x[[dt_i]]),
idx_start = node_idx_start
)
rel_data = sankey_compare(
data_dt = data.table::as.data.table(x[[dt_i]]),
idx_start = node_idx_start
)

# append data
links_dt = rbind(links_dt, rel_data$links)
nodes = c(nodes, rel_data$nodes)
# append data
links_dt = rbind(links_dt, rel_data$links)
nodes = c(nodes, rel_data$nodes)

# update start index
node_idx_start = links_dt[, max(source, target)] + 1
}
# update start index
node_idx_start = links_dt[, max(source, target)] + 1
}

# create nodes table
nodes_dt = data.table::data.table(name = nodes)

sankey_networkd3(
Links = links_dt,
Nodes = nodes_dt,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'name',
...
)
})
# create nodes table
nodes_dt = data.table::data.table(name = nodes)

sankey_networkd3(
Links = links_dt,
Nodes = nodes_dt,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'name',
focus_names = focus_names,
unfocused_color = unfocused_color,
...
)
})


#' @rdname sankeyPlot
#' @export
setMethod('sankeyPlot',
signature(x = 'giottoPolygon', y = 'giottoPolygon'),
function(x, y, ...) {

# take the poly_ID cols only from each gpoly
# then perform intersect
# finally, pass to sankeyPlot
terra::intersect(x[,1][], y[,1][])[,1:2] %>%
terra::values() %>%
data.table::setDT() %>%
data.table::setnames(new = c('a_ID', 'b_ID')) %>%
data.table::setkeyv(c('a_ID', 'b_ID')) %>%
sankeyPlot()

})
setMethod(
'sankeyPlot',
signature(x = 'giottoPolygon',
y = 'giottoPolygon'),
function(x, y, focus_names = NULL, unfocused_color = FALSE, ...)
{
# take the poly_ID cols only from each gpoly
# then perform intersect
# finally, pass to sankeyPlot
terra::intersect(x[,1][], y[,1][])[,1:2] %>%
terra::values() %>%
data.table::setDT() %>%
data.table::setnames(new = c('a_ID', 'b_ID')) %>%
data.table::setkeyv(c('a_ID', 'b_ID')) %>%
sankeyPlot(focus_names = focus_names,
unfocused_color = unfocused_color,
...)
})


sankey_networkd3 = function(Links,
Expand All @@ -715,18 +744,34 @@ sankey_networkd3 = function(Links,
NodeID = 'name',
nodePadding = 1,
sinksRight = FALSE,
focus_names = NULL,
unfocused_replacer = '',
unfocused_color = FALSE,
...) {
networkD3::sankeyNetwork(
Links = Links,
Nodes = Nodes,
Source = 'source',
Target = 'target',
Value = 'value',
NodeID = 'name',
nodePadding = nodePadding,
sinksRight = sinksRight,
...
)

args_list <- list()

if (!is.null(focus_names)) {
Nodes[!get('name') %in% focus_names, 'name' := unfocused_replacer]

if (isTRUE(unfocused_color)) {
Nodes[, color := as.character(seq(.N))]
args_list$NodeGroup <- 'color'
}
}

args_list <- c(args_list,
list(Links = Links,
Nodes = Nodes,
Source = Source,
Target = Target,
Value = Value,
NodeID = NodeID,
nodePadding = nodePadding,
sinksRight = sinksRight),
list(...))

do.call(networkD3::sankeyNetwork, args = args_list)
}


25 changes: 21 additions & 4 deletions man/sankeyPlot.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.