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.

Sign up for GitHub

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

Jump to bottom

feat: edge color by variable #614

Merged
merged 1 commit into from
Jan 27, 2024
Merged

feat: edge color by variable #614

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
31 changes: 23 additions & 8 deletions R/add.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1069,6 +1069,7 @@ e_sankey.echarts4rProxy <- function(e, source, target, value, layout = "none", r
#' @param xpos,ypos X and Y coordinates for nodes. Valid when \code{layout = "none"}
#' @param edges Data.frame of edges.
#' @param source,target Column names of source and target.
#' @param color Variable to map to the color of the edges.
#' @param layout Layout, one of \code{force}, \code{none} or \code{circular}.
#' @param rm_x,rm_y Whether to remove the x and y axis, defaults to \code{TRUE}.
#' @param itemStyle This option is available for for GL and canvas
Expand Down Expand Up @@ -1122,7 +1123,7 @@ e_sankey.echarts4rProxy <- function(e, source, target, value, layout = "none", r
#' e_graph_nodes(nodes, name, value, size, grp) |>
#' e_graph_edges(edges, source, target)
#'
#' # Fixed node positions
#' # Fixed node positions, and edge color by variable
#' nodes <- data.frame(
#' name = c("A", "B", "C", "D", "E"),
#' value = c("A", "B", "C", "D", "E"),
Expand All @@ -1134,13 +1135,15 @@ e_sankey.echarts4rProxy <- function(e, source, target, value, layout = "none", r
#'
#' edges <- data.frame(
#' source = c("A", "B", "C", "D", "E"),
#' target = c("B", "C", "D", "E", "D")
#' target = c("B", "C", "D", "E", "D"),
#' size = rep(3, 5),
#' color = c("red", "green", "blue", "yellow", "black")
#' )
#'
#' e_charts() |>
#' e_graph(layout = "none", autoCurveness = TRUE) |>
#' e_graph_nodes(nodes, name, value, size, category = group, xpos = x, ypos = y) |>
#' e_graph_edges(edges, source, target) |>
#' e_graph_edges(edges, source, target, size = size, color = color) |>
#' e_tooltip()
#' @seealso \href{https://echarts.apache.org/en/option.html#series-graph}{Additional arguments},
#' \code{\link{e_modularity}}
Expand Down Expand Up @@ -1359,11 +1362,11 @@ e_graph_nodes.echarts4rProxy <- function(e, nodes, names, value, size, category,

#' @rdname graph
#' @export
e_graph_edges <- function(e, edges, source, target, value, size) UseMethod("e_graph_edges")
e_graph_edges <- function(e, edges, source, target, value, size, color) UseMethod("e_graph_edges")

#' @method e_graph_edges echarts4r
#' @export
e_graph_edges.echarts4r <- function(e, edges, source, target, value, size) {
e_graph_edges.echarts4r <- function(e, edges, source, target, value, size, color) {
if (missing(edges) || missing(source) || missing(target)) {
stop("must pass edges, source and target", call. = FALSE)
}
Expand All @@ -1376,17 +1379,23 @@ e_graph_edges.echarts4r <- function(e, edges, source, target, value, size) {
value <- NULL
}

if (missing(color)) {
color <- NULL
}

source <- dplyr::enquo(source)
target <- dplyr::enquo(target)
value <- dplyr::enquo(value)
size <- dplyr::enquo(size)
color <- dplyr::enquo(color)

data <- .build_graph_edges(
edges,
source,
target,
value,
size
size,
color
)

# build JSON data
Expand All @@ -1397,7 +1406,7 @@ e_graph_edges.echarts4r <- function(e, edges, source, target, value, size) {

#' @method e_graph_edges echarts4rProxy
#' @export
e_graph_edges.echarts4rProxy <- function(e, edges, source, target, value, size) {
e_graph_edges.echarts4rProxy <- function(e, edges, source, target, value, size, color) {
if (missing(edges) || missing(source) || missing(target)) {
stop("must pass edges, source and target", call. = FALSE)
}
Expand All @@ -1406,17 +1415,23 @@ e_graph_edges.echarts4rProxy <- function(e, edges, source, target, value, size)
size <- NULL
}

if (missing(color)) {
color <- NULL
}

source <- dplyr::enquo(source)
target <- dplyr::enquo(target)
value <- dplyr::enquo(value)
size <- dplyr::enquo(size)
color <- dplyr::enquo(color)

data <- .build_graph_edges(
edges,
source,
target,
value,
size
size,
color
)

# build JSON data
Expand Down
55 changes: 52 additions & 3 deletions R/utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -260,10 +260,10 @@ globalVariables(c("x", "e", ".", "acc", "epoch", "loss", "size", "val_acc", "val
apply(data, 1, as.list)
}

.build_graph_edges <- function(edges, source, target, value, size) {
.build_graph_edges <- function(edges, source, target, value, size, color) {
row.names(edges) <- NULL

if (is.null(size)) {
if (is.null(size) && is.null(color)) {
data <- edges |>
dplyr::select(
source = !!source,
Expand All @@ -272,7 +272,9 @@ globalVariables(c("x", "e", ".", "acc", "epoch", "loss", "size", "val_acc", "val
)

x <- apply(data, 1, as.list)
} else {
}

if (!is.null(size) && is.null(color)) {
data <- edges |>
dplyr::select(
source = !!source,
Expand All @@ -294,6 +296,53 @@ globalVariables(c("x", "e", ".", "acc", "epoch", "loss", "size", "val_acc", "val
})
}

if (!is.null(color) && is.null(size)) {
data <- edges |>
dplyr::select(
source = !!source,
target = !!target,
value = !!value,
color = !!color
)

x <- apply(data, 1, function(x) {
list(
source = unname(x["source"]),
target = unname(x["target"]),
value = {
if (is.null(value)) "" else unname(x["value"])
},
lineStyle = list(color = unname(x["color"]))
)
})
}

if (!is.null(size) && !is.null(color)) {
data <- edges |>
dplyr::select(
source = !!source,
target = !!target,
value = !!value,
size = !!size,
color = !!color
)

x <- apply(data, 1, function(x) {
list(
source = unname(x["source"]),
target = unname(x["target"]),
value = {
if (is.null(value)) "" else unname(x["value"])
},
symbolSize = c(5, 20),
lineStyle = list(
width = unname(x["size"]),
color = unname(x["color"])
)
)
})
}

x
}

Expand Down
Loading