tidyexplain/R/move_together.R

#' Combines two processed datasets and combines them for a given method
#'
#' @param lhs the left-hand side dataset
#' @param rhs the righ-hand side dataset
#' @param type a string of the desired combination method, allowed are all dplyr
#'             joins or sets
#'
#' @return  processed dataset of the combined values
#'
#' @examples
#' NULL
move_together <- function(lhs, rhs, type) {

  all_ids <- bind_rows(lhs, rhs) %>% distinct(.id)

  all <- bind_rows(lhs, rhs)

  x_cols <- lhs %>% distinct(col)
  y_cols <- rhs %>% distinct(col)

  x_ids <- lhs %>% distinct(.id)
  y_ids <- rhs %>% distinct(.id)

  if (type == "full_join") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::full_join
  } else if (type == "inner_join") {
    col_combiner <- dplyr::inner_join
    row_combiner <- dplyr::inner_join
  } else if (type == "left_join") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::left_join
  } else if (type == "right_join") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::right_join
  } else if (type == "semi_join") {
    col_combiner <- dplyr::semi_join
    row_combiner <- dplyr::semi_join
  } else if (type == "anti_join") {
    col_combiner <- dplyr::semi_join
    row_combiner <- dplyr::anti_join
  } else if (type == "union") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::union
  } else if (type == "union_all") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::union_all

    x_ids <- lhs %>% distinct(.id = .id_long)
    y_ids <- rhs %>% distinct(.id = .id_long)
    all <- all %>% rename(id_old = .id, .id = .id_long)
    # all <- all %>% rename(.id = .id_long)
  } else if (type == "intersect") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::intersect
  } else if (type == "setdiff") {
    col_combiner <- dplyr::full_join
    row_combiner <- dplyr::anti_join
  } else {
    stop("Unknown func")
  }

  take_cols <- col_combiner(x_cols, y_cols, by = "col")
  take_ids  <- row_combiner(x_ids, y_ids, by = ".id")
  # make sure .header is always the first
  id_number <- which(str_detect(take_ids$.id, "^.header"))
  if (length(id_number) != 0)
    take_ids <- take_ids[c(id_number, (1:nrow(take_ids))[-id_number]), ]
  if (!any(str_detect(take_ids$.id, "^.header")))
    take_ids <- bind_rows(data_frame(.id = ".header"), take_ids)

  take <- tidyr::crossing(take_ids, take_cols)

  mid <- (2 + length(unique(lhs$col)) + length(unique(rhs$col))) / 2
  xvals <- 1:nrow(take_cols)
  xvals <- xvals - mean(xvals) + mid
  names(xvals) <- take_cols %>% pull(col)

  n_non_header <- sum(str_detect(take_ids$.id, "^[^\\.header]"))
  yvals <- cumsum(ifelse(str_detect(take_ids$.id, "^\\.header"), 0, -1))
  names(yvals) <- take_ids %>% pull(.id)

  take_vals <- semi_join(all, take, by = c(".id", "col")) %>%
    mutate(.alpha = 1,
           .x = xvals[col],
           .y = yvals[.id])

  if (type ==  "union_all") {
    take_vals <- take_vals %>% rename(.id_long = .id, .id = id_old)
  }

  res <- bind_rows(
    # take,
    take_vals,
    # fade in place:
    all %>% filter(!.id %in% take_ids$.id) %>% mutate(.alpha = 0),
    # moving fade or fade in place as well:
    all %>% filter(.id %in% take_ids$.id & !col %in% take_cols$col) %>%
      mutate(.alpha = 0)
  )
  return(res)
}