inst/doc/funkyheatmap.R

In funkyheatmap: Generating Funky Heatmaps for Data Frames

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  dev = "png",
  fig.width = 8,
  fig.height = 11.5
)


## ----check_on_cran, message=FALSE, warning=FALSE, echo=FALSE------------------
on_cran <- !identical(Sys.getenv("NOT_CRAN"), "true")

if (on_cran) {
  knitr::opts_chunk$set(eval = FALSE)
  knitr::asis_output(paste0(
    "<span style=\"color: red;\">**WARNING:** The outputs of this vignette are not rendered on CRAN due to package size limitations. ",
    "Please check the [Getting started](https://funkyheatmap.github.io/funkyheatmap/articles/funkyheatmap.html) ",
    "vignette in the package documentation. </span>"
  ))
}

## ----load-data----------------------------------------------------------------
# library(funkyheatmap)
# library(dplyr, warn.conflicts = FALSE)
# library(tibble, warn.conflicts = FALSE)
# library(purrr, warn.conflicts = FALSE)
# 
# data("mtcars")
# 
# data <- mtcars %>%
#   rownames_to_column("id") %>%
#   arrange(desc(mpg)) %>%
#   head(30)

## ----basic-fh-----------------------------------------------------------------
# funky_heatmap(data)

## ----column-group-------------------------------------------------------------
# cinfo <- tibble(
#   id = colnames(data),
#   group = c(NA, "Overall", "Engine", "Engine", "Engine", "Transmission", "Overall", "Performance", "Engine", "Transmission", "Transmission", "Engine"),
#   options = lapply(seq(12), function(x) lst())
# )
# cinfo

## ----column-info-fh-----------------------------------------------------------
# funky_heatmap(data, column_info = cinfo)

## ----column-group-sort--------------------------------------------------------
# data <- data[, c("id", "qsec", "mpg", "wt", "cyl", "carb", "disp", "hp", "vs", "drat", "am", "gear")]
# 
# cinfo <- tibble(
#   id = colnames(data),
#   group = c(NA, "Performance", rep("Overall", 2), rep("Engine", 5), rep("Transmission", 3)),
#   options = lapply(seq(12), function(x) lst())
# )
# cinfo
# 
# funky_heatmap(data, column_info = cinfo)

## ----column-info-name---------------------------------------------------------
# cinfo$name <- c("Model", "1/4 mile time", "Miles per gallon", "Weight", "Number of cylinders", "Carburetors", "Displacement", "Horsepower", "Engine type", "Rear axle ratio", "Transmission", "Forward gears")
# funky_heatmap(data, column_info = cinfo)

## ----column-info-palette------------------------------------------------------
# cinfo$palette <- c(NA, "perf_palette", rep("overall_palette", 2), rep("engine_palette", 5), rep("transmission_palette", 3))
# 
# palettes <- list(perf_palette = "Blues", overall_palette = "Greens", engine_palette = "YlOrBr", transmission_palette = "Reds")
# 
# funky_heatmap(data, column_info = cinfo, palettes = palettes)

## ----column-group-df----------------------------------------------------------
# column_groups <- tibble(
#   Category = c("Performance", "Overall", "Engine", "Transmission"),
#   group = c("Performance", "Overall", "Engine", "Transmission"),
#   palette = c("perf_palette", "overall_palette", "engine_palette", "transmission_palette")
# )
# 
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes)

## ----column-info-geom---------------------------------------------------------
# cinfo$geom <- c("text", "bar", "bar", "bar", "rect", "rect", "funkyrect", "funkyrect", "circle", "funkyrect", "rect", "rect")
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes)

## ----column-info-text---------------------------------------------------------
# # column_info$options <- lapply(seq(12), function(x) lst())
# cinfo <- cinfo %>%
#   add_row(id = "cyl", group = "Engine", name = "", geom = "text", options = lst(lst(overlay = TRUE)), palette = "black", .before = 6) %>%
#   add_row(id = "carb", group = "Engine", name = "", geom = "text", options = lst(lst(overlay = TRUE)), palette = "black", .before = 8) %>%
#   add_row(id = "am", group = "Transmission", name = "", geom = "text", options = lst(lst(overlay = TRUE)), palette = "black", .before = 14) %>%
#   add_row(id = "gear", group = "Transmission", name = "", geom = "text", options = lst(lst(overlay = TRUE)), palette = "black", .before = 17)
# 
# cinfo
# 
# palettes$black <- c(rep("black", 2))
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes)

## ----legends------------------------------------------------------------------
# palettes$funky_palette_grey <- RColorBrewer::brewer.pal(9, "Greys")[-1] %>% rev()
# 
# legends <- list(
#     list(
#         palette = "perf_palette",
#         geom = "bar",
#         title = "1/4 mile time",
#         labels = c(paste0(min(data$qsec), "s"), rep("", 8), paste0(max(data$qsec), "s"))
#     ),
#     list(
#         palette = "overall_palette",
#         geom = "bar",
#         title = "Miles per gallon",
#         labels = c(paste0(min(data$mpg), "mpg"), rep("", 8), paste0(max(data$mpg), "mpg"))
#     ),
#     list(
#         palette = "overall_palette",
#         geom = "bar",
#         title = "Weight",
#         labels = c(paste0(min(data$wt), "lbs"), rep("", 8), paste0(max(data$wt), "lbs"))
#     ),
#     list(
#         palette = "funky_palette_grey",
#         geom = "funkyrect",
#         title = "Overall",
#         enabled = TRUE,
#         labels = c("0", "", "0.2", "", "0.4", "", "0.6", "", "0.8", "", "1")
#     )
# )
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes, legends = legends)

## ----legends-disable----------------------------------------------------------
# disabled_legends = list(
#     list(
#         palette = "engine_palette",
#         enabled = FALSE
#     ),
#     list(
#         palette = "transmission_palette",
#         enabled = FALSE
#     )
# )
# 
# # append disabled_legends to legends
# legends <- c(legends, disabled_legends)
# 
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes, legends = legends)

## ----images-------------------------------------------------------------------
# # change the am: if 0 go to "automatic", if 1 go to "manual"
# data[data$am == 0, "am"] <- "automatic"
# data[data$am == 1, "am"] <- "manual"
# 
# # change the vs: if 0 go to "vengine", if 1 go to "straight"
# data[data$vs == 0, "vs"] <- "vengine"
# data[data$vs == 1, "vs"] <- "straight"
# 
# cinfo$directory <- NA
# cinfo$extension <- NA
# 
# # remove row 14
# cinfo <- cinfo[-14, ]
# 
# cinfo[cinfo$id %in% c("vs", "am"), "directory"] <- "images"
# cinfo[cinfo$id %in% c("vs", "am"), "extension"] <- "png"
# cinfo[c(11, 13), "geom"] <- "image"
# 
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes, legends = legends)

## ----row-grouping-------------------------------------------------------------
# row_info <- data %>% transmute(id, group = ifelse(grepl("Merc", id), "Mercedes", "Other"))
# # sort Mercedes cars to the top of the data and the row_info dataframe
# data <- data[order(row_info$group), ]
# row_info <- row_info[order(row_info$group), ]
# 
# row_groups <- tibble(level1 = c("Mercedes", "Other cars"), group = c("Mercedes", "Other"))
# 
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes, legends = legends, row_info = row_info, row_groups = row_groups)

## ----additions----------------------------------------------------------------
# # set options of performance column
# cinfo[[1, "options"]] <- list(list(width = 6))
# cinfo[[2, "options"]] <- list(list(width = 6))
# cinfo[[3, "options"]] <- list(list(width = 3))
# cinfo[[4, "options"]] <- list(list(width = 3))
# cinfo[[12, "options"]] <- list(list(width = 1.85))
# cinfo[[13, "options"]] <- list(list(width = 1.85))
# 
# funky_heatmap(data, column_info = cinfo, column_groups = column_groups, palettes = palettes, legends = legends, row_info = row_info, row_groups = row_groups)
#