## ----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( "**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. " )) } ## ----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) #