Skip to content

Commit

Permalink
Merge pull request #20 from jiajic/dev
Browse files Browse the repository at this point in the history
update: `sankeyPlot()`
  • Loading branch information
jiajic authored Nov 2, 2023
2 parents b9225ed + d72b256 commit 1bd59c0
Show file tree
Hide file tree
Showing 2 changed files with 143 additions and 81 deletions.
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.

0 comments on commit 1bd59c0

Please sign in to comment.