R/iNZGG.R

Defines functions iNZightPlotGG_quasirandom iNZightPlotGG_ridgeline iNZightPlotGG_beeswarm iNZightPlotGG_divergingstackedbar iNZightPlotGG_gridplot iNZightPlotGG_lollipop2 iNZightPlotGG_mosaic iNZightPlotGG_density iNZightPlotGG_dotstrip iNZightPlotGG_freqpolygon iNZightPlotGG_spine iNZightPlotGG_poppyramid iNZightPlotGG_cumcurve iNZightPlotGG_lollipop iNZightPlotGG_column2 iNZightPlotGG_boxplot iNZightPlotGG_barcode3 iNZightPlotGG_barcode2 iNZightPlotGG_barcode iNZightPlotGG_violin iNZightPlotGG_stackedbar iNZightPlotGG_stackedcolumn iNZightPlotGG_heatmap iNZightPlotGG_bar rotate iNZightPlotGG_column iNZightPlotGG_donut iNZightPlotGG_pie iNZightPlotGG iNZightPlotGG_extraargs iNZightPlotGG_decide iNZightPlotGG_facet count_nas check_nas apply_palette rotate_gridplot add_to_group insert_into_first_place replace_data_name

required_arguments <- list(
  pie = c("fill"),
  donut = c("fill"),
  column = c("x")
)

optional_args <- list(
  gg_violin = c("adjust", "alpha"),
  gg_density = c("adjust", "alpha", "alpha_densitygroup"),
  gg_lollipop = c("gg_lwd", "labels", "gg_size"),
  gg_boxplot = c("gg_lwd"),
  gg_cumcurve = c("gg_lwd"),
  gg_column = c("ordered"),
  gg_lollipop2 = c("ordered", "gg_lwd", "gg_size"),
  gg_pie = c("ordered"),
  gg_donut = c("ordered"),
  gg_column2 = c("labels"),
  gg_barcode = c("alpha", "gg_barSize"),
  gg_dotstrip = c("alpha", "gg_size"),
  gg_poppyramid = c("gg_bins"),
  gg_freqpolygon = c("gg_lwd", "gg_size"),
  gg_barcode2 = c("gg_height", "gg_width", "alpha"),
  gg_barcode3 = c("gg_height", "gg_width", "alpha"),
  gg_beeswarm = c("gg_size", "rotation"),
  gg_ridgeline = c("alpha", "alpha_densitygroup"),
  gg_gridplot = c("gg_perN"),
  gg_quasirandom = c("gg_size", "gg_swarmwidth", "gg_method"),
  gg_divergingstackedbar = c("gg_cutpoint")
)

replace_data_name <- function(expr, new_name) {
  if (is.name(expr[[2]])) {
    expr[[2]] <- rlang::sym(new_name)
  } else {
    expr[[2]] <- replace_data_name(expr[[2]], new_name)
  }

  expr
}

insert_into_first_place <- function(expr, insert_expr) {
  if (is.name(expr[[2]])) {
    expr[[2]] <- rlang::expr(!!expr[[2]] %>% !!insert_expr)
  } else {
    expr[[2]] <- insert_into_first_place(expr[[2]], insert_expr)
  }

  expr
}

add_to_group <- function(expr, vars) {
  if (expr[[3]][[1]] == "dplyr::group_by") {
    expr[[3]] <- as.call(c(as.list(expr[[3]]), vars))
  } else if (expr[[3]][[1]] == "dplyr::ungroup") {
    expr[[3]] <- as.call(list(rlang::expr(dplyr::group_by), vars))
  }

  if (is.name(expr[[2]])) {
    expr
  } else {
    expr[[2]] <- add_to_group(expr[[2]], vars)
    expr
  }
}

rotate_gridplot <- function(expr) {
  if (expr[[1]] == "waffle::waffle") {
    expr$flip <- TRUE
  }

  expr
}

apply_palette <- function(expr, palette, type) {
  viridis_names <- unname(unlist(viridis_palette_names()))
  colour_plots <- c("gg_cumcurve", "gg_lollipop", "gg_freqpolygon", "gg_barcode", "gg_dotstrip", "gg_quasirandom", "gg_lollipop2", "gg_barcode3", "gg_dotstrip")

  if (palette %in% viridis_names) {
    if (type %in% colour_plots) {
      rlang::expr(!!expr + ggplot2::scale_colour_viridis_d(option = !!palette))
    } else {
      if (type != "gg_heatmap") {
        rlang::expr(!!expr + ggplot2::scale_fill_viridis_d(option = !!palette))
      } else {
        rlang::expr(!!expr + ggplot2::scale_fill_viridis_c(option = !!palette))
      }
    }
  } else if (palette == "greyscale") {
    if (type %in% colour_plots) {
      rlang::expr(!!expr + ggplot2::scale_colour_grey())
    } else {
      if (type != "gg_heatmap") {
        rlang::expr(!!expr + ggplot2::scale_fill_grey())
      } else {
        rlang::expr(!!expr + ggplot2::scale_fill_gradient(low = "white", high = "black"))
      }
    }
  } else {
    if (type %in% colour_plots) {
      rlang::expr(!!expr + ggplot2::scale_colour_brewer(palette = !!palette))
    } else {
      if (type != "gg_heatmap") {
        rlang::expr(!!expr + ggplot2::scale_fill_brewer(palette = !!palette))
      } else {
        rlang::expr(!!expr + ggplot2::scale_fill_distiller(palette = !!palette))
      }
    }
  }
}

check_nas <- function(data, exprs, data_name, plot_args) {
  plot_varnames <- unlist(plot_args[plot_args %in% names(data)])

  if (any(vapply(data[, plot_varnames, drop = FALSE], anyNA, logical(1)))) {
    complete <- complete.cases(data[, plot_varnames])

    plot_varnames <- rlang::syms(plot_varnames)

    if (is.null(exprs$data)) {
      exprs <- list(
        data = rlang::expr(plot_data <- !!rlang::sym(data_name) %>% tidyr::drop_na(!!!plot_varnames)),
        plot = replace_data_name(exprs$plot, "plot_data")
      )

      exprs$plot <- rlang::expr(!!exprs$plot + ggplot2::labs(subtitle = !!sprintf("%d Missing Observations Removed", sum(!complete))))
    } else {
      exprs$data[[3]] <- insert_into_first_place(exprs$data[[3]], rlang::expr(tidyr::drop_na()))

      exprs$plot <- rlang::expr(!!exprs$plot + ggplot2::labs(subtitle = !!sprintf("%d Missing Observations Removed", sum(!complete))))
    }
  }

  exprs
}

count_nas <- function(data, exprs, data_name, plot_args) {
  plot_varnames <- unlist(plot_args[plot_args %in% names(data)])

  if (any(vapply(data[, plot_varnames, drop = FALSE], anyNA, logical(1)))) {
    complete <- complete.cases(data[, plot_varnames])
    exprs$plot <- rlang::expr(!!exprs$plot + ggplot2::labs(subtitle = !!sprintf("%d Missing Observations Removed", sum(!complete))))
  }

  exprs
}

iNZightPlotGG_facet <- function(data, data_name, exprs, g1, g2, g1.level, g2.level) {
  if (!is.null(g1) && length(g1) > 0) {
    if (!is.null(g1.level) && g1.level != "_MULTI") {
      if (is.null(exprs$data)) {
        exprs <- list(
          data = rlang::expr(plot_data <- !!rlang::sym(data_name) %>% dplyr::filter(!!rlang::sym(g1) == !!g1.level)),
          plot = replace_data_name(exprs$plot, "plot_data")
        )
      } else {
        exprs$data[[3]] <- insert_into_first_place(exprs$data[[3]], rlang::expr(dplyr::filter(!!rlang::sym(g1) == !!g1.level)))
        exprs$data[[3]] <- add_to_group(exprs$data[[3]], rlang::sym(g1))
      }
    } else {
      if (!is.null(exprs$data)) {
        exprs$data[[3]] <- add_to_group(exprs$data[[3]], rlang::sym(g1))
      }
    }
  }

  if (!is.null(g2) && length(g2) > 0) {
    if (!is.null(g2.level) && g2.level != "_MULTI" && g2.level != "_ALL") {
      if (is.null(exprs$data)) {
        exprs <- list(
          data = rlang::expr(plot_data <- !!rlang::sym(data_name) %>% dplyr::filter(!!rlang::sym(g2) == !!g2.level)),
          plot = replace_data_name(exprs$plot, "plot_data")
        )

        exprs$data[[3]] <- add_to_group(exprs$data[[3]], rlang::sym(g2))
      } else {
        exprs$data[[3]] <- insert_into_first_place(exprs$data[[3]], rlang::expr(dplyr::filter(!!rlang::sym(g2) == !!g2.level)))
        exprs$data[[3]] <- add_to_group(exprs$data[[3]], rlang::sym(g2))
      }
    } else {
      if (!is.null(exprs$data)) {
        exprs$data[[3]] <- add_to_group(exprs$data[[3]], rlang::sym(g2))
      }
    }
  }

  if (isTRUE(is.null(g2) || length(g2) == 0)) {
    exprs$plot <- rlang::expr(!!exprs$plot + ggplot2::facet_wrap(ggplot2::vars(!!rlang::sym(g1)), labeller = ggplot2::label_both))
  } else {
    if (!is.null(g2.level) && g2.level == "_MULTI") {
      exprs$plot <- rlang::expr(!!exprs$plot + ggplot2::facet_grid(cols = ggplot2::vars(!!rlang::sym(g1)), rows = ggplot2::vars(!!rlang::sym(g2)), labeller = ggplot2::label_both))
    } else {
      exprs$plot <- rlang::expr(!!exprs$plot + ggplot2::facet_wrap(ggplot2::vars(!!rlang::sym(g1)), labeller = ggplot2::label_both))
    }
  }

  exprs
}

iNZightPlotGG_decide <- function(data, varnames, type, extra_vars) {
  varnames <- varnames[grep("\\.level$", names(varnames), invert = TRUE)]
  varnames <- varnames[grep("g1", names(varnames), invert = TRUE)]
  varnames <- varnames[grep("g2", names(varnames), invert = TRUE)]
  non_mapped <- varnames[grep("^(x|y)$", names(varnames), invert = TRUE)]
  varnames <- varnames[grep("^(x|y)$", names(varnames))]
  varnames <- varnames[varnames != ""]
  nullVars <- vapply(data[, varnames, drop = FALSE], is.null, FUN.VALUE = logical(1))
  varnames[which(nullVars)] <- NULL

  varnames[!varnames %in% colnames(data)] <- NULL

  if (type %in% c("gg_pie", "gg_donut")) {
    names(varnames) <- replace(names(varnames), names(varnames) == "x", "fill")
  } else if (type %in% c("gg_violin", "gg_barcode", "gg_boxplot", "gg_cumcurve", "gg_column2", "gg_lollipop", "gg_dotstrip", "gg_density", "gg_barcode2", "gg_beeswarm", "gg_ridgeline", "gg_quasirandom", "gg_barcode3")) {
    if (!("y" %in% names(varnames))) {
      names(varnames) <- replace(names(varnames), names(varnames) == "x", "y")
      if (isTRUE(!is.null(extra_vars$fill_colour) && extra_vars$fill_colour != "")) {
        if (type %in% c("gg_lollipop", "gg_cumcurve", "gg_barcode", "gg_dotstrip", "gg_quasirandom", "gg_barcode3")) {
          varnames["colour"] <- extra_vars$fill_colour
        } else {
          varnames["fill"] <- extra_vars$fill_colour
        }
      } else if (type != "gg_cumcurve") {
        varnames["fill"] <- "darkgreen"
      }
    } else if (is.numeric(data[[varnames["x"]]])) {
      orig_x <- varnames["x"]
      varnames["x"] <- varnames["y"]
      varnames["y"] <- orig_x
    }

    # if (type %in% c("gg_barcode", "gg_dotstrip") && isTRUE(!is.null(extra_vars$fill_colour) && extra_vars$fill_colour != "")) {
    #   varnames["colour"] <- extra_vars$fill_colour
    # }
  } else if (type %in% c("gg_stackedbar", "gg_stackedcolumn")) {
    names(varnames) <- replace(names(varnames), names(varnames) == "x", "fill")
    if ("y" %in% names(varnames)) {
      names(varnames) <- replace(names(varnames), names(varnames) == "y", "x")
    }
  } else if (type == "gg_poppyramid") {
    if (is.numeric(data[[varnames["x"]]])) {
      names(varnames) <- replace(names(varnames), names(varnames) == "y", "fill")
    } else {
      names(varnames) <- replace(names(varnames), names(varnames) == "x", "fill")
      names(varnames) <- replace(names(varnames), names(varnames) == "y", "x")
    }
  } else if (type == "gg_spine") {
    names(varnames) <- replace(names(varnames), names(varnames) == "y", "fill")
  } else if (type == "gg_freqpolygon") {
    names(varnames) <- replace(names(varnames), names(varnames) == "y", "colour")
  } else if (type == "gg_column") {
    if ("y" %in% names(varnames)) {
      names(varnames) <- replace(names(varnames), names(varnames) == "y", "group")
    }
  }

  if (type %in% c("gg_column2", "gg_lollipop")) {
    names(varnames) <- replace(names(varnames), names(varnames) == "labels", "x")
  }

  extra_args <- Filter(Negate(is.null), extra_vars[optional_args[[type]]])

  varnames <- as.list(varnames)

  if (!is.null(extra_args) && length(extra_args) > 0) {
    varnames <- append(as.list(varnames), as.list(extra_args))
    names(varnames) <- sub("^gg_", "", names(varnames))

    if (type %in% c("gg_barcode")) {
      if ("barSize" %in% names(varnames)) {
        names(varnames) <- replace(names(varnames), names(varnames) == "barSize", "size")
      } else {
        varnames[["size"]] <- 16
      }
    }

    if (type %in% c("gg_barcode2")) {
      if ("width" %in% names(varnames)) {
        varnames[["width"]] <- as.numeric(varnames[["width"]])
        # names(non_mapped) <- replace(names(non_mapped), names(non_mapped) == "gg_width", "width")
      }

      if ("height" %in% names(varnames)) {
        varnames[["height"]] <- as.numeric(varnames[["height"]])
        # names(non_mapped) <- replace(names(non_mapped), names(non_mapped) == "gg_height", "height")
      }
    }

    if (type %in% c("gg_barcode3")) {
      if ("width" %in% names(varnames)) {
        varnames[["size"]] <- as.numeric(varnames[["width"]])
        varnames[["width"]] <- NULL
      }

      if ("height" %in% names(varnames)) {
        varnames[["radius"]] <- as.numeric(varnames[["height"]])
        varnames[["height"]] <- NULL
      }
    }

    if (type %in% c("gg_density", "gg_ridgeline")) {
      if ("x" %in% names(varnames)) {
        varnames[["alpha"]] <- NULL
        varnames[["alpha_density"]] <- NULL

        if (!is.null(varnames[["alpha_densitygroup"]])) {
          names(varnames) <- replace(names(varnames), names(varnames) == "alpha_densitygroup", "alpha")
        } else {
          varnames[["alpha"]] <- 0.6
        }
      }

      if (!is.null(varnames[["alpha"]])) {
        varnames[["alpha"]] <- as.numeric(varnames[["alpha"]])
      }
    }

    if (type %in% c("gg_quasirandom")) {
      names(varnames) <- replace(names(varnames), names(varnames) == "swarmwidth", "width")
    }

    if (type %in% c("gg_lollipop2")) {
      if (!("y" %in% names(varnames))) {
        if (isTRUE(!is.null(extra_vars$fill_colour) && extra_vars$fill_colour != "")) {
          varnames[["colour"]] <- extra_vars$fill_colour
        }
      }
    }
  }

  if (type %in% c("gg_lollipop", "gg_lollipop2", "gg_freqpolygon", "gg_dotstrip", "gg_beeswarm", "gg_quasirandom")) {
    if (!("size" %in% names(varnames))) {
      varnames[["size"]] <- 6
    }
  }

  append(varnames, as.list(non_mapped))
}

iNZightPlotGG_extraargs <- function(extra_args) {
  to.keep <- c(
    "shape" = "pch",
    "colour" = "col.pt",
    "size" = "cex",
    "alpha" = "alpha",
    "bg" = "bg",
    "adjust" = "adjust",
    "lwd" = "lwd",
    "gg_lwd" = "gg_lwd",
    "mean_indicator" = "mean_indicator"
  )

  extra_args <- extra_args[to.keep]

  changed_args <- Filter(function(x) extra_args[[x]] != inzpar()[[x]], names(extra_args))

  return_args <- extra_args[changed_args]
  names(return_args) <- names(to.keep)[match(names(return_args), to.keep)]

  return_args
}

##' @importFrom magrittr "%>%"
##' @importFrom rlang ":="
iNZightPlotGG <- function(
    data,
    type,
    data_name = "data",
    ...,
    main = NULL,
    xlab = NULL,
    ylab = NULL,
    caption = NULL,
    extra_args = c(),
    palette = "default",
    gg_theme = "grey") {
  dots <- list(...)

  if (length(extra_args) > 0) {
    rotate <- extra_args$rotation
    desc <- extra_args$desc
    overall_size <- extra_args$cex
    rotate_labels <- extra_args$rotate_labels

    extra_args$desc <- desc
  }

  plot_args <- iNZightPlotGG_decide(data, unlist(dots), type, extra_args)

  plot_exprs <- do.call(
    sprintf("iNZightPlotGG_%s", gsub("^gg_", "", type)),
    c(rlang::sym(data_name), main = main, xlab = xlab, ylab = ylab, plot_args)
  )

  if (!(type %in% c("gg_pie", "gg_donut", "gg_cumcurve"))) {
    if (type == "gg_gridplot" && isTRUE(rotate)) {
      plot_exprs$plot <- rotate_gridplot(plot_exprs$plot)
    } else {
      default_rotated <- c("gg_boxplot", "gg_violin", "gg_beeswarm", "gg_quasirandom", "gg_lollipop", "gg_column2", "gg_spine")

      if (type %in% default_rotated) {
        rotate <- if (!is.null(rotate)) !rotate else TRUE
      }

      if (isTRUE(rotate)) {
        plot_exprs$plot <- rotate(plot_exprs$plot)
      }
    }
  }

  if (length(gg_theme) > 0 && gg_theme != "grey") {
    theme_fun <- list(
      "bw" = rlang::expr(ggplot2::theme_bw()),
      "light" = rlang::expr(ggplot2::theme_light()),
      "dark" = rlang::expr(ggplot2::theme_dark()),
      "minimal" = rlang::expr(ggplot2::theme_minimal()),
      "classic" = rlang::expr(ggplot2::theme_classic()),
      "void" = rlang::expr(ggplot2::theme_void()),
      "stata" = rlang::expr(ggthemes::theme_stata()),
      "wsj" = rlang::expr(ggthemes::theme_wsj()),
      "tufte" = rlang::expr(ggthemes::theme_tufte()),
      "gdocs" = rlang::expr(ggthemes::theme_gdocs()),
      "fivethirtyeight" = rlang::expr(ggthemes::theme_fivethirtyeight()),
      "excel" = rlang::expr(ggthemes::theme_excel()),
      "economist" = rlang::expr(ggthemes::theme_economist())
    )[[gg_theme]]

    plot_exprs$plot <- rlang::expr(!!plot_exprs$plot + !!theme_fun)
  }

  plot_exprs$plot <- rlang::expr(!!plot_exprs$plot +
    ggplot2::theme(
      plot.title = ggtext::element_textbox_simple(
        margin = ggplot2::margin(0, 0, 8, 0)
      ),
      plot.title.position = "plot",
      axis.title.x = ggtext::element_textbox_simple(
        halign = 0.5,
        margin = ggplot2::margin(10, 0, 8, 0)
      )
    ))

  if (!is.null(extra_args$mean_indicator) && (
    isTRUE(extra_args$mean_indicator) || extra_args$mean_indicator %in% c("grand", "group")
  )) {
    if (type %in% c("gg_boxplot")) {
      plot_exprs$plot <- rlang::expr(
        !!plot_exprs$plot +
          ggplot2::geom_point(
            data = function(x) {
              x %>%
                dplyr::group_by(!!rlang::sym(plot_args$x), drop = FALSE) %>%
                dplyr::summarize(Mean = mean(!!rlang::sym(plot_args$y), na.rm = TRUE))
            },
            ggplot2::aes(
              x = !!rlang::sym(plot_args$x),
              y = !!rlang::sym("Mean")
            ),
            shape = 8,
            size = 2,
            colour = "black"
          )
      )
    }
    if (type %in% c("gg_density")) {
      dexpr <- rlang::expr(!!rlang::sym("x"))
      fill <- "mean"
      mean_palette <- rlang::expr(ggplot2::scale_colour_manual(values = c(mean = "black")))
      if (!is.null(plot_args$x) && extra_args$mean_indicator == "group") {
        dexpr <- rlang::expr(!!dexpr %>%
          dplyr::group_by(!!rlang::sym(plot_args$x), drop = FALSE))
        fill <- rlang::sym(plot_args$x)
        mean_palette <- NULL
      }
      dexpr <- rlang::expr(!!dexpr %>%
        dplyr::summarise(Mean = mean(!!rlang::sym(plot_args$y), na.rm = TRUE)))
      plot_exprs$plot <- rlang::expr(
        !!plot_exprs$plot +
          ggplot2::geom_vline(
            data = function(x) {
              !!dexpr
            },
            ggplot2::aes(
              xintercept = !!rlang::sym("Mean"),
              colour = !!fill
            ),
            lty = 2
          )
      )
      if (!is.null(mean_palette)) {
        plot_exprs$plot <- rlang::expr(
          !!plot_exprs$plot + !!mean_palette
        )
      }
    }
  }

  if (exists("rotate_labels") && !(type %in% c("gg_pie", "gg_donut", "gg_cumcurve", "gg_gridplot"))) {
    if (isTRUE(rotate_labels$x)) {
      plot_exprs$plot <- rlang::expr(!!plot_exprs$plot + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, vjust = 1, hjust = 1)))
    }

    if (isTRUE(rotate_labels$y)) {
      plot_exprs$plot <- rlang::expr(!!plot_exprs$plot + ggplot2::theme(axis.text.y = ggplot2::element_text(angle = 45, vjust = 1, hjust = 1)))
    }
  }

  if (exists("overall_size") && !is.null(overall_size) && isTRUE(overall_size != 1)) {
    plot_exprs$plot <- rlang::expr(!!plot_exprs$plot + ggplot2::theme(text = ggplot2::element_text(size = !!(as.numeric(overall_size) * 11))))
  }

  if (isTRUE(!extra_args$bg %in% c("lightgrey", "#eeeeee") && type != "gg_gridplot")) {
    plot_exprs$plot <- rlang::expr(!!plot_exprs$plot + ggplot2::theme(panel.background = ggplot2::element_rect(fill = !!extra_args$bg)))
  }

  if (isTRUE(!is.null(dots$g1) && length(dots$g1) > 0)) {
    plot_exprs <- iNZightPlotGG_facet(data, data_name, plot_exprs, dots$g1, dots$g2, dots$g1.level, dots$g2.level)
  }

  if (isTRUE(!missing(palette) && !is.null(palette) && palette != "default")) {
    plot_exprs$plot <- apply_palette(plot_exprs$plot, palette, type)
  }

  if (!(type %in% c("gg_lollipop", "gg_column2"))) {
    plot_exprs <- check_nas(data, plot_exprs, data_name, unname(plot_args))
  } else {
    plot_exprs <- count_nas(data, plot_exprs, data_name, unname(plot_args))
  }

  if (isTRUE(!is.null(caption) && caption != "")) {
    plot_exprs$plot <- rlang::expr(!!plot_exprs$plot + ggplot2::labs(caption = caption))
  }

  if (type %in% c("gg_barcode3", "gg_dotstrip", "gg_ridgeline")) {
    plot_exprs$plot <- rlang::expr(
      !!plot_exprs$plot + ggplot2::scale_y_discrete(limits = rev)
    )
    # } else if (type %in% c("gg_violin", "gg_boxplot", "gg_beeswarm", "gg_quasirandom")) {
  } else if (type %in% c("gg_violin", "gg_boxplot", "gg_quasirandom") && rotate) {
    plot_exprs$plot <- rlang::expr(
      !!plot_exprs$plot + ggplot2::scale_x_discrete(limits = rev)
    )
  }

  eval_env <- rlang::env(!!rlang::sym(data_name) := data)
  eval_results <- lapply(plot_exprs, eval, envir = eval_env)

  plot_object <- eval_results[[length(eval_results)]]

  dev.hold()
  tryCatch(
    print(plot_object),
    finally = dev.flush()
  )

  attr(plot_object, "code") <- unname(unlist(lapply(plot_exprs, rlang::expr_text)))
  attr(plot_object, "code_expr") <- plot_exprs
  attr(plot_object, "data_name") <- data_name
  attr(plot_object, "plottype") <- c(type)
  attr(plot_object, "varnames") <- unlist(dots)
  attr(plot_object, "use.plotly") <- !type %in% c("gg_pie", "gg_donut", "gg_gridplot", "gg_barcode2", "gg_barcode", "gg_ridgeline")

  if (type %in% c("gg_lollipop", "gg_column2")) {
    attr(plot_object, "varnames") <- attr(plot_object, "varnames")[names(attr(plot_object, "varnames")) != "y"]
  }

  invisible(plot_object)
}

iNZightPlotGG_pie <- function(data, fill, main = sprintf("Pie Chart of %s", as.character(fill)), ordered = FALSE, ...) {
  fill <- rlang::sym(fill)

  if (ordered == "desc") {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::mutate(!!fill := forcats::fct_infreq(!!fill))
    )

    data <- rlang::sym("plot_data")
  } else if (ordered == "asc") {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::mutate(!!fill := forcats::fct_rev(forcats::fct_infreq(!!fill)))
    )

    data <- rlang::sym("plot_data")
  }

  plot_expr <- rlang::expr(
    ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = factor(1), fill = !!fill)) +
      ggplot2::geom_bar(
        ggplot2::aes(
          y = ggplot2::after_stat(!!rlang::sym("count")) /
            sum(ggplot2::after_stat(!!rlang::sym("count")))
        ),
        position = "fill"
      ) +
      ggplot2::coord_polar(theta = "y") +
      ggplot2::xlab("") +
      ggplot2::ylab("") +
      ggplot2::scale_y_reverse() +
      ggplot2::scale_x_discrete(breaks = NULL) +
      ggplot2::ggtitle(!!main) +
      ggplot2::theme(
        panel.grid.major = ggplot2::element_blank(),
        panel.grid.minor = ggplot2::element_blank(),
        axis.text.x      = ggplot2::element_blank()
      )
  )

  if (ordered %in% c("asc", "desc")) {
    list(
      data = data_expr,
      plot = plot_expr
    )
  } else {
    list(
      plot = plot_expr
    )
  }
}

iNZightPlotGG_donut <- function(data, fill, main = sprintf("Donut Chart of %s", as.character(fill)), ordered = FALSE, ...) {
  fill <- rlang::sym(fill)

  if (ordered == "desc") {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::mutate(!!fill := forcats::fct_infreq(!!fill)) %>%
        dplyr::group_by(!!fill) %>%
        dplyr::summarise(Count = dplyr::n()) %>%
        dplyr::ungroup() %>%
        dplyr::mutate(Fraction = !!rlang::sym("Count") / sum(!!rlang::sym("Count"))) %>%
        dplyr::arrange(dplyr::desc(!!rlang::sym("Fraction"))) %>%
        dplyr::mutate(ymax = cumsum(!!rlang::sym("Fraction"))) %>%
        dplyr::mutate(ymin = dplyr::lag(!!rlang::sym("ymax"), default = 0))
    )
  } else if (ordered == "asc") {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::mutate(!!fill := forcats::fct_rev(forcats::fct_infreq(!!fill))) %>%
        dplyr::group_by(!!fill) %>%
        dplyr::summarise(Count = dplyr::n()) %>%
        dplyr::ungroup() %>%
        dplyr::mutate(Fraction = !!rlang::sym("Count") / sum(!!rlang::sym("Count"))) %>%
        dplyr::arrange(!!rlang::sym("Fraction")) %>%
        dplyr::mutate(ymax = cumsum(!!rlang::sym("Fraction"))) %>%
        dplyr::mutate(ymin = dplyr::lag(!!rlang::sym("ymax"), default = 0))
    )
  } else {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::group_by(!!fill) %>%
        dplyr::summarise(Count = dplyr::n()) %>%
        dplyr::ungroup() %>%
        dplyr::mutate(Fraction = !!rlang::sym("Count") / sum(!!rlang::sym("Count"))) %>%
        dplyr::mutate(ymax = cumsum(!!rlang::sym("Fraction"))) %>%
        dplyr::mutate(ymin = dplyr::lag(!!rlang::sym("ymax"), default = 0))
    )
  }

  plot_expr <- rlang::expr(
    ggplot2::ggplot(plot_data, ggplot2::aes(fill = !!fill, ymax = !!rlang::sym("ymax"), ymin = !!rlang::sym("ymin"), xmax = 4, xmin = 3)) +
      ggplot2::geom_rect() +
      ggplot2::coord_polar(theta = "y") +
      ggplot2::xlab("") +
      ggplot2::ylab("") +
      ggplot2::scale_x_continuous(breaks = NULL, limits = c(0, 4)) +
      ggplot2::scale_y_continuous(labels = scales::percent) +
      ggplot2::ggtitle(!!main) +
      ggplot2::theme(
        panel.grid.major = ggplot2::element_blank(),
        panel.grid.minor = ggplot2::element_blank(),
        axis.text.x      = ggplot2::element_blank()
      )
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_column <- function(data, x, group, main = sprintf("Column chart of %s", as.character(x)), xlab = as.character(x), ylab = "Count", ordered = FALSE, ...) {
  x <- rlang::sym(x)

  if (ordered == "desc") {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::mutate(!!x := forcats::fct_infreq(!!x))
    )

    data <- rlang::sym("plot_data")
  } else if (ordered == "asc") {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::mutate(!!x := forcats::fct_rev(forcats::fct_infreq(!!x)))
    )

    data <- rlang::sym("plot_data")
  }

  if (missing(group)) {
    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, fill = !!x)) +
        ggplot2::geom_bar() +
        ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!xlab, 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  } else {
    group <- rlang::sym(group)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, fill = !!group)) +
        ggplot2::geom_bar(position = "dodge") +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }


  if (ordered %in% c("asc", "desc")) {
    list(
      data = data_expr,
      plot = plot_expr
    )
  } else {
    list(
      plot = plot_expr
    )
  }
}

rotate <- function(plot_expr) {
  check_for_function <- function(expr, fun, i = 0) {
    if (length(expr) == 1) {
      as.character(expr) == fun
    } else {
      if (rlang::call_name(expr[[3]]) == fun) {
        TRUE
      } else {
        check_for_function(expr[[2]], fun)
      }
    }
  }

  remove_function <- function(expr, fun, i = 0) {
    if (length(expr) == 1) {
      if (as.character(expr) == fun) {
        expr <- NULL
        expr
      }
    } else {
      if (rlang::call_name(expr[[3]]) == fun) {
        expr[[2]]
      } else {
        expr[[2]] <- remove_function(expr[[2]], fun)
        expr
      }
    }
  }

  if (check_for_function(plot_expr, "coord_flip")) {
    remove_function(plot_expr, "coord_flip")
  } else {
    rlang::expr(!!plot_expr + ggplot2::coord_flip())
  }
}

iNZightPlotGG_bar <- function(data, x, main = "Bar chart", ...) {
  column_plot <- iNZightPlotGG_column(data, x, main, ...)

  column_plot$plot <- rotate(column_plot$plot)

  column_plot
}

iNZightPlotGG_heatmap <- function(data, x, y, main = sprintf("Heatmap of %s and %s", as.character(x), as.character(y)), xlab = as.character(x), ylab = as.character(y), ...) {
  x <- rlang::sym(x)
  y <- rlang::sym(y)

  data_expr <- rlang::expr(
    plot_data <- !!rlang::enexpr(data) %>%
      dplyr::group_by(!!x, !!y) %>%
      dplyr::summarise(Count = dplyr::n())
  )

  plot_expr <- rlang::expr(
    ggplot2::ggplot(plot_data, ggplot2::aes(x = !!x, y = !!y)) +
      ggplot2::geom_tile(ggplot2::aes(fill = !!rlang::sym("Count"))) +
      ggplot2::labs(title = !!main) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_stackedcolumn <- function(data, fill, main = sprintf("Stacked column of %s", as.character(fill)), x, xlab = as.character(x), ylab = "Percent", ...) {
  fill <- rlang::sym(fill)

  if (missing(x)) {
    x <- rlang::expr(factor(1))
    was_missing <- TRUE
  } else {
    x <- rlang::sym(x)
    was_missing <- FALSE
  }

  plot_expr <- rlang::expr(
    ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, fill = !!fill)) +
      ggplot2::geom_bar(
        ggplot2::aes(
          y = ggplot2::after_stat(!!rlang::sym("count")) /
            sum(ggplot2::after_stat(!!rlang::sym("count")))
        ),
        position = "fill"
      ) +
      ggplot2::scale_y_continuous(labels = scales::percent) +
      ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  if (isTRUE(was_missing)) {
    plot_expr <- rlang::expr(
      !!plot_expr +
        ggplot2::scale_x_discrete(breaks = NULL) +
        ggplot2::xlab("")
    )
  } else {
    plot_expr <- rlang::expr(
      !!plot_expr +
        ggplot2::xlab(!!xlab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_stackedbar <- function(data, fill, main = sprintf("Stacked bar of %s", as.character(fill)), x, ...) {
  column_plot <- iNZightPlotGG_stackedcolumn(!!rlang::enexpr(data), fill, main, x, ...)

  column_plot$plot <- rotate(column_plot$plot)

  column_plot
}

iNZightPlotGG_violin <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(x), ylab = as.character(y), ...) {
  y <- rlang::sym(y)

  dots <- list(...)

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y)) +
        ggplot2::geom_violin(fill = !!fill, !!!dots) +
        ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
        ggplot2::xlab("") +
        ggplot2::ylab(!!ylab) +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    fill <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y, fill = !!fill)) +
        ggplot2::geom_violin(!!!dots) +
        ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_barcode <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(y), ylab = as.character(x), ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x)) +
        ggplot2::geom_point(shape = "|", !!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab("") +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    colour <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x)) +
        ggplot2::geom_point(shape = "|", !!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_barcode2 <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(y), ylab = as.character(x), ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x)) +
        ggplot2::geom_tile(!!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab("") +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    colour <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x)) +
        ggplot2::geom_tile(!!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_barcode3 <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(y), ylab = as.character(x), ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (is.null(dots$radius)) {
    radius <- 0.5
    dots$radius <- 0.5
  } else {
    radius <- dots$radius
  }

  if (is.null(dots$size)) {
    dots$size <- 1
  }

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    if (!is.null(dots$size)) {
      # ggplot2::geom_spoke has deprecated `size` in favor of `linewidth`
      dots$linewidth <- dots$size
      dots$size <- NULL
    }

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x)) +
        ggplot2::geom_spoke(angle = pi / 2, position = ggplot2::position_nudge(y = -!!radius / 2), !!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab("") +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    colour <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x, colour = !!colour)) +
        ggplot2::geom_spoke(angle = pi / 2, position = ggplot2::position_nudge(y = -!!radius / 2), !!!dots) +
        ggplot2::labs(title = !!main, colour = stringr::str_wrap(!!as.character(colour), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_boxplot <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(x), ylab = as.character(y), ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y)) +
        ggplot2::geom_boxplot(fill = !!fill, !!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab("") +
        ggplot2::ylab(!!ylab) +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    fill <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y, fill = !!fill)) +
        ggplot2::geom_boxplot(!!!dots) +
        ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_column2 <- function(data, x, y, main = sprintf("Distribution of %s", as.character(y)), xlab = "Index", ylab = as.character(y), desc = FALSE, labels, ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    if (missing(labels) || labels == "") {
      x <- rlang::expr(1:nrow(!!rlang::enexpr(data)))

      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::arrange(!!y)
      )
    } else {
      x <- rlang::sym(labels)

      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::arrange(!!y) %>%
          dplyr::mutate(!!x := forcats::fct_reorder(!!x, !!y))
      )
    }
  } else {
    x <- rlang::sym(x)

    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::arrange(!!y) %>%
        dplyr::mutate(!!x := forcats::fct_reorder(!!x, !!y))
    )
  }

  plot_expr <- rlang::expr(
    ggplot2::ggplot(plot_data, ggplot2::aes(x = !!x, y = !!y)) +
      ggplot2::geom_col(!!!dots) +
      ggplot2::labs(title = !!main) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_lollipop <- function(data, x, y, main = sprintf("Distribution of %s", as.character(y)), xlab = "Index", ylab = as.character(y), desc = FALSE, labels, ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  point_dots <- dots[c("size", "colour")]
  line_dots <- dots[c("lwd", "colour")]

  point_dots <- Filter(Negate(is.null), point_dots)
  line_dots <- Filter(Negate(is.null), line_dots)

  if (missing(x)) {
    if (missing(labels) || labels == "") {
      x <- rlang::expr(1:nrow(!!rlang::enexpr(data)))

      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::arrange(!!y)
      )
    } else {
      x <- rlang::sym(labels)

      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::arrange(!!y) %>%
          dplyr::mutate(!!x := forcats::fct_reorder(!!x, !!y))
      )
    }
  } else {
    x <- rlang::sym(x)

    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::arrange(!!y) %>%
        dplyr::mutate(!!x := forcats::fct_reorder(!!x, !!y))
    )
  }

  plot_expr <- rlang::expr(
    ggplot2::ggplot(plot_data, ggplot2::aes(x = !!x, y = !!y)) +
      ggplot2::geom_segment(ggplot2::aes(xend = !!x, yend = 0), !!!line_dots) +
      ggplot2::geom_point(!!!point_dots) +
      ggplot2::labs(title = !!main) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_cumcurve <- function(data, x, y, main = sprintf("Cumulative Curve of %s", as.character(y)), xlab = as.character(y), ylab = "Cumulative Frequency", ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::arrange(!!y) %>%
        dplyr::mutate(Observation = 1:dplyr::n())
    )

    plot_expr <- rlang::expr(
      ggplot2::ggplot(plot_data, ggplot2::aes(x = !!y, y = !!rlang::sym("Observation"))) +
        ggplot2::geom_step(!!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  } else {
    x <- rlang::sym(x)

    data_expr <- rlang::expr(
      plot_data <- !!rlang::enexpr(data) %>%
        dplyr::group_by(!!x) %>%
        dplyr::arrange(!!x, !!y) %>%
        dplyr::mutate(Observation = 1:dplyr::n())
    )

    plot_expr <- rlang::expr(
      ggplot2::ggplot(plot_data, ggplot2::aes(x = !!y, y = !!rlang::sym("Observation"), colour = !!x)) +
        ggplot2::geom_step(!!!dots) +
        ggplot2::labs(title = !!main, colour = stringr::str_wrap(!!as.character(x), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_poppyramid <- function(data, x, fill, main = sprintf("Count of %s by %s", as.character(x), as.character(fill)), xlab = as.character(x), ylab = "Count", ...) {
  x <- rlang::sym(x)
  fill <- rlang::sym(fill)
  dots <- list(...)

  plot_expr <- rlang::expr(
    ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, fill = !!fill)) +
      ggplot2::geom_histogram(data = subset(!!rlang::enexpr(data), !!fill == levels(!!fill)[1]), !!!dots) +
      ggplot2::geom_histogram(
        data = subset(
          !!rlang::enexpr(data),
          !!fill == levels(!!fill)[2]
        ),
        ggplot2::aes(
          y = ggplot2::after_stat(!!rlang::sym("count")) * -1
        ),
        !!!dots
      ) +
      ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab) +
      ggplot2::scale_y_continuous(labels = abs)
  )

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_spine <- function(data, x, fill, main = sprintf("Count of %s by %s", as.character(x), as.character(fill)), xlab = as.character(x), ylab = "Count", ...) {
  x <- rlang::sym(x)
  fill <- rlang::sym(fill)
  dots <- list(...)

  plot_expr <- rlang::expr(
    ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, fill = !!fill)) +
      ggplot2::geom_bar(data = subset(!!rlang::enexpr(data), !!fill == levels(!!fill)[1]), !!!dots) +
      ggplot2::geom_bar(
        data = subset(
          !!rlang::enexpr(data),
          !!fill == levels(!!fill)[2]
        ),
        ggplot2::aes(
          y = !!rlang::sym("count") * -1
        ),
        !!!dots
      ) +
      ggplot2::coord_flip() +
      ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab) +
      ggplot2::scale_y_continuous(labels = abs)
  )

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_freqpolygon <- function(data, x, colour, main = sprintf("Count of %s by %s", as.character(x), as.character(colour)), xlab = as.character(x), ylab = "Count", ...) {
  x <- rlang::sym(x)
  colour <- rlang::sym(colour)
  dots <- list(...)

  point_dots <- dots[c("size", "colour")]
  line_dots <- dots[c("lwd", "colour")]

  point_dots <- Filter(Negate(is.null), point_dots)
  line_dots <- Filter(Negate(is.null), line_dots)

  plot_expr <- rlang::expr(
    ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, colour = !!colour, group = !!colour)) +
      ggplot2::geom_line(stat = "count", !!!line_dots) +
      ggplot2::geom_point(stat = "count", !!!point_dots) +
      ggplot2::labs(title = !!main, colour = stringr::str_wrap(!!as.character(colour), 40)) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_dotstrip <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(y), ylab = as.character(x), ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x)) +
        ggplot2::geom_point(!!!dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab("") +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    colour <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x, colour = !!colour)) +
        ggplot2::geom_point(!!!dots) +
        ggplot2::labs(title = !!main, colour = stringr::str_wrap(!!as.character(colour), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_density <- function(data, x, y, fill = "darkgreen", main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(y), ylab = "Density", ...) {
  y <- rlang::sym(y)
  dots <- list(...)

  if (missing(x)) {
    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y)) +
        ggplot2::geom_density(fill = !!fill, !!!dots) +
        ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  } else {
    fill <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, fill = !!fill)) +
        ggplot2::geom_density(!!!dots) +
        ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(fill), 40)) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_mosaic <- function(data, x, y, main = sprintf("Mosaic plot of %s and %s", as.character(x), as.character(y)), xlab = as.character(x), ylab = as.character(y), ...) {
  # library("ggmosaic")
  # mosaic plots don't work unless the package is attached

  if (!"package:ggmosaic" %in% search()) {
    stop("Please install and load the 'ggmosaic' library\n # library(ggmosaic)")
  }

  x <- rlang::sym(x)
  y <- rlang::sym(y)

  data_expr <- rlang::expr(
    plot_data <- !!rlang::enexpr(data) %>%
      dplyr::select(!!x, !!y) %>%
      dplyr::mutate(!!x := factor(!!x)) %>%
      dplyr::mutate(!!y := factor(!!y))
  )

  plot_expr <- rlang::expr(
    ggplot2::ggplot(plot_data) +
      ggmosaic::geom_mosaic(ggplot2::aes(x = ggmosaic::product(!!x), fill = !!y)) +
      ggplot2::labs(title = !!main, fill = stringr::str_wrap(!!as.character(y), 40)) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_lollipop2 <- function(data, x, y, main = sprintf("Count of %s", as.character(x)), xlab = as.character(x), ylab = "Count", ordered = FALSE, ...) {
  x <- rlang::sym(x)
  dots <- list(...)

  point_dots <- dots[c("size", "colour")]
  line_dots <- dots[c("lwd", "colour")]

  point_dots <- Filter(Negate(is.null), point_dots)
  line_dots <- Filter(Negate(is.null), line_dots)

  if (missing(y)) {
    if (ordered %in% c("desc", "asc")) {
      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::group_by(!!x) %>%
          dplyr::summarise(Count = dplyr::n()) %>%
          dplyr::ungroup() %>%
          dplyr::mutate(!!x := forcats::fct_reorder(!!x, !!rlang::sym("Count"), .desc = !!(ordered == "desc")))
      )
    } else {
      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::group_by(!!x) %>%
          dplyr::summarise(Count = dplyr::n())
      )
    }

    plot_expr <- rlang::expr(
      ggplot2::ggplot(plot_data, ggplot2::aes(!!x, !!rlang::sym("Count"))) +
        ggplot2::geom_point(!!!point_dots) +
        ggplot2::geom_segment(ggplot2::aes(xend = !!x, yend = 0), !!!line_dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  } else {
    y <- rlang::sym(y)

    if (ordered %in% c("desc", "asc")) {
      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::group_by(!!x, !!y) %>%
          dplyr::summarise(Count = dplyr::n()) %>%
          dplyr::ungroup() %>%
          dplyr::mutate(!!x := forcats::fct_reorder(!!x, !!rlang::sym("Count"), .desc = !!(ordered == "desc")))
      )
    } else {
      data_expr <- rlang::expr(
        plot_data <- !!rlang::enexpr(data) %>%
          dplyr::group_by(!!x, !!y) %>%
          dplyr::summarise(Count = dplyr::n())
      )
    }

    plot_expr <- rlang::expr(
      ggplot2::ggplot(plot_data, ggplot2::aes(x = !!x, colour = !!y, y = !!rlang::sym("Count"))) +
        ggplot2::geom_point(position = ggplot2::position_dodge(width = 0.5), !!!point_dots) +
        ggplot2::geom_linerange(ggplot2::aes(ymin = 0, ymax = !!rlang::sym("Count")), position = ggplot2::position_dodge(width = 0.5), !!!line_dots) +
        ggplot2::labs(title = !!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_gridplot <- function(data, x, main = sprintf("Gridplot of %s", as.character(x)), xlab = sprintf("%s observation/square", perN), perN = 1, ...) {
  x <- rlang::sym(x)

  data_expr <- rlang::expr(
    plot_data <- !!rlang::enexpr(data) %>%
      dplyr::select(!!x) %>%
      table() %>%
      magrittr::divide_by_int(!!as.integer(perN))
  )

  plot_expr <- rlang::expr(
    waffle::waffle(plot_data, title = !!main, xlab = !!xlab)
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_divergingstackedbar <- function(data, x, y, main = sprintf("Diverging stacked bar of %s by %s", as.character(y), as.character(x)), xlab = as.character(x), ylab = "Count", cutpoint = NULL, ...) {
  orig_x <- x
  x <- rlang::sym(y)

  y <- rlang::sym(orig_x)

  if (is.null(cutpoint) || cutpoint == "Default") {
    cutpoint <- rlang::expr(floor(nlevels(!!y) / 2))
  } else {
    cutpoint <- rlang::enexpr(cutpoint)
  }

  data_expr <- rlang::expr(
    plot_data <- !!rlang::enexpr(data) %>%
      dplyr::group_by(!!x, !!y) %>%
      dplyr::summarise(Count = dplyr::n())
  )

  plot_expr <- rlang::expr(
    ggplot2::ggplot(plot_data, ggplot2::aes(x = !!x, fill = !!y)) +
      ggplot2::geom_col(data = subset(plot_data, !!y %in% levels(!!y)[1:!!cutpoint]), ggplot2::aes(y = -!!rlang::sym("Count"))) +
      ggplot2::geom_col(data = subset(plot_data, !(!!y %in% levels(!!y)[1:!!cutpoint])), ggplot2::aes(y = !!rlang::sym("Count")), position = ggplot2::position_stack(reverse = TRUE)) +
      ggplot2::geom_hline(yintercept = 0) +
      ggplot2::coord_flip() +
      ggplot2::labs(title = !!main) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab) +
      ggplot2::scale_y_continuous(labels = abs) +
      ggplot2::scale_fill_discrete(breaks = levels(plot_data[[!!as.character(y)]]))
  )

  list(
    data = data_expr,
    plot = plot_expr
  )
}

iNZightPlotGG_beeswarm <- function(data, x, y, main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(x), ylab = as.character(y), rotation = FALSE, ...) {
  y <- rlang::sym(y)

  dots <- list(...)


  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y)) +
        ggbeeswarm::geom_beeswarm(!!!dots) +
        ggplot2::ggtitle(!!main) +
        ggplot2::xlab("") +
        ggplot2::ylab(!!ylab) +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)
    if (rotation) {
      plot_expr <- rlang::expr(
        ggplot2::ggplot(
          !!rlang::enexpr(data),
          ggplot2::aes(x = !!x, y = !!y, colour = !!x)
        ) +
          ggbeeswarm::geom_beeswarm(!!!dots) +
          ggplot2::ggtitle(!!main) +
          ggplot2::xlab(!!xlab) +
          ggplot2::ylab(!!ylab)
      )
    } else {
      plot_expr <- rlang::expr(
        ggplot2::ggplot(
          !!rlang::enexpr(data),
          ggplot2::aes(x = factor(!!x, levels = rev(levels(!!x))), y = !!y, colour = !!x)
        ) +
          ggbeeswarm::geom_beeswarm(!!!dots) +
          ggplot2::ggtitle(!!main) +
          ggplot2::xlab(!!xlab) +
          ggplot2::ylab(!!ylab)
      )
    }
  }

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_ridgeline <- function(data, x, y, main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(y), ylab = as.character(x), ...) {
  x <- rlang::sym(x)
  y <- rlang::sym(y)

  dots <- list(...)

  plot_expr <- rlang::expr(
    ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!y, y = !!x, fill = !!x)) +
      ggridges::geom_density_ridges(!!!dots) +
      ggplot2::ggtitle(!!main) +
      ggplot2::xlab(!!xlab) +
      ggplot2::ylab(!!ylab)
  )

  list(
    plot = plot_expr
  )
}

iNZightPlotGG_quasirandom <- function(data, x, y, main = sprintf("Distribution of %s", as.character(y)), xlab = as.character(x), ylab = as.character(y), ...) {
  y <- rlang::sym(y)

  dots <- list(...)

  if (missing(x)) {
    x <- rlang::expr(factor(1))

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y)) +
        ggbeeswarm::geom_quasirandom(!!!dots) +
        ggplot2::ggtitle(!!main) +
        ggplot2::xlab("") +
        ggplot2::ylab(!!ylab) +
        ggplot2::theme(
          axis.text.y = ggplot2::element_blank(),
          axis.ticks.y = ggplot2::element_blank()
        )
    )
  } else {
    x <- rlang::sym(x)

    plot_expr <- rlang::expr(
      ggplot2::ggplot(!!rlang::enexpr(data), ggplot2::aes(x = !!x, y = !!y, colour = !!x)) +
        ggbeeswarm::geom_quasirandom(!!!dots) +
        ggplot2::ggtitle(!!main) +
        ggplot2::xlab(!!xlab) +
        ggplot2::ylab(!!ylab)
    )
  }

  list(
    plot = plot_expr
  )
}
iNZightVIT/iNZightPlots documentation built on April 8, 2024, 10:24 a.m.