## -----------------------------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## -----------------------------------------------------------------------------
library(xmap)
library(dplyr)

## -----------------------------------------------------------------------------
simple_xmap <- demo$simple_links |>
  as_xmap_tbl(xcode, alphacode, weight)
simple_xmap

simple_data <- demo$simple_links |>
  distinct(xcode) |>
  mutate(xcode_mass = 100)
simple_data

## -----------------------------------------------------------------------------
# Node-link diagram of an xmap_tbl's .from -> .to structure, using
# ggforce::geom_diagonal() for the connecting curves -- see
# https://github.com/cynthiahqy/xmap/issues/51
plot_xmap_bigraph <- function(.xmap) {
  edges <- tibble::tibble(
    from = .xmap$.from[[1]],
    to = .xmap$.to[[1]],
    weight = .xmap$.weight_by[[1]]
  )

  from_nodes <- distinct(edges, from) |> mutate(from_y = row_number())
  to_nodes <- distinct(edges, to) |> mutate(to_y = row_number() - 1 + 0.5)

  edges <- edges |>
    left_join(from_nodes, by = "from") |>
    left_join(to_nodes, by = "to") |>
    mutate(
      is_split = weight < 1,
      curve_linetype = ifelse(is_split, "dashed", "solid"),
      id = row_number()
    )

  labels <- edges |>
    filter(is_split) |>
    mutate(label_x = 0.5, label_y = (from_y + to_y) / 2)

  ggplot2::ggplot() +
    ggforce::geom_diagonal(
      data = edges,
      ggplot2::aes(
        x = 0,
        y = from_y,
        xend = 1,
        yend = to_y,
        group = id,
        linetype = I(curve_linetype),
        alpha = weight,
        colour = from
      ),
      linewidth = 0.6,
      n = 100
    ) +
    ggplot2::geom_label(
      data = from_nodes,
      ggplot2::aes(x = 0, y = from_y, label = from),
      linewidth = 0,
      fill = "grey95"
    ) +
    ggplot2::geom_label(
      data = to_nodes,
      ggplot2::aes(x = 1, y = to_y, label = to),
      linewidth = 0,
      fill = "grey95"
    ) +
    ggrepel::geom_label_repel(
      data = labels,
      ggplot2::aes(x = label_x, y = label_y, label = weight, fill = from),
      size = 3,
      label.size = 0,
      colour = "white",
      seed = 1,
      direction = "x",
      max.overlaps = Inf,
      min.segment.length = 0
    ) +
    ggplot2::scale_colour_discrete(
      aesthetics = c("colour", "fill"),
      limits = unique(edges$from)
    ) +
    ggplot2::scale_y_reverse() +
    ggplot2::scale_alpha_continuous(range = c(0.4, 1)) +
    ggplot2::scale_x_continuous(limits = c(-0.15, 1.15)) +
    ggplot2::theme_void() +
    ggplot2::theme(legend.position = "none")
}

# Alluvial (flow) diagram of the same structure, encoding .weight_by as
# ribbon width instead of a discrete edge + label -- see
# https://github.com/cynthiahqy/xmap/issues/51
plot_xmap_alluvial <- function(.xmap) {
  edges <- tibble::tibble(
    from = .xmap$.from[[1]],
    to = .xmap$.to[[1]],
    weight = .xmap$.weight_by[[1]]
  ) |>
    mutate(is_split = weight < 1)

  ggplot2::ggplot(
    edges,
    ggplot2::aes(axis1 = from, axis2 = to, y = weight)
  ) +
    ggalluvial::geom_alluvium(ggplot2::aes(fill = from, alpha = is_split)) +
    ggalluvial::geom_stratum(width = 1 / 4, fill = "grey95") +
    ggalluvial::stat_stratum(
      geom = "text",
      ggplot2::aes(label = ggplot2::after_stat(stratum)),
      size = 3.2
    ) +
    ggplot2::scale_x_discrete(
      limits = c("xcode", "alphacode"),
      expand = c(0.15, 0.15)
    ) +
    ggplot2::scale_alpha_manual(values = c(`TRUE` = 0.9, `FALSE` = 0.5)) +
    ggplot2::theme_void() +
    ggplot2::theme(legend.position = "none")
}

## -----------------------------------------------------------------------------
plot_xmap_bigraph(simple_xmap)

## -----------------------------------------------------------------------------
apply_xmap(
  simple_data,
  simple_xmap,
  values_from = xcode_mass,
  keys_from = xcode
)

## -----------------------------------------------------------------------------
validate_apply_xmap(
  simple_data,
  simple_xmap,
  values_from = xcode_mass,
  keys_from = xcode
)

## -----------------------------------------------------------------------------
plot_xmap_alluvial(simple_xmap)

## -----------------------------------------------------------------------------
partial_xmap <- demo$simple_links |>
  filter(xcode != "x7777") |>
  as_xmap_tbl(xcode, alphacode, weight)

## -----------------------------------------------------------------------------
diagnose_apply_xmap(
  simple_data,
  partial_xmap,
  values_from = xcode_mass,
  keys_from = xcode
)

## -----------------------------------------------------------------------------
try({
apply_xmap(
  simple_data,
  partial_xmap,
  values_from = xcode_mass,
  keys_from = xcode
)
})

## -----------------------------------------------------------------------------
na_data <- simple_data
na_data$xcode_mass[na_data$xcode == "x1111"] <- NA
na_data$xcode_mass[na_data$xcode == "x6666"] <- NA
na_data

## -----------------------------------------------------------------------------
try({
apply_xmap(
  na_data,
  simple_xmap,
  values_from = xcode_mass,
  keys_from = xcode
)
})

## -----------------------------------------------------------------------------
diagnose_apply_xmap(
  na_data,
  simple_xmap,
  values_from = xcode_mass,
  keys_from = xcode
)

## -----------------------------------------------------------------------------
na_remove <- na_data |>
  filter(!is.na(xcode_mass))
na_remove

## -----------------------------------------------------------------------------
na_replace <- na_data |>
  mutate(xcode_mass = tidyr::replace_na(xcode_mass, 0))
na_replace

## -----------------------------------------------------------------------------
na_remove |>
  apply_xmap(simple_xmap, values_from = xcode_mass, keys_from = xcode)

## -----------------------------------------------------------------------------
na_replace |>
  apply_xmap(simple_xmap, values_from = xcode_mass, keys_from = xcode)