diff --git a/DESCRIPTION b/DESCRIPTION index fcdb981..9b2c6b2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,7 @@ Depends: R (>= 3.5.0) License: What license is it under? Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 Imports: tidyverse, ggplot2, grid, diff --git a/NAMESPACE b/NAMESPACE index 7e568ce..7aa2e18 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(makeContent,icon_grob) export(GeomIcon) export(ddecker) export(geom_bloc) @@ -12,6 +13,7 @@ export(spine) export(vbar) export(vspine) import(dplyr) +import(grid) import(rlang) importFrom(dplyr,filter) importFrom(dplyr,intersect) diff --git a/R/geom-bloc.R b/R/geom-bloc.R index 013e711..4068e3b 100644 --- a/R/geom-bloc.R +++ b/R/geom-bloc.R @@ -126,6 +126,7 @@ GeomBloc <- ggplot2::ggproto( # from ggplot, geom-ribbon.r setup_data = function(self, data, params){ #browser() + if ("density" %in% names(data)) { #browser() # all density plots diff --git a/R/geom-icon.R b/R/geom-icon.R index 6582857..5c5359f 100644 --- a/R/geom-icon.R +++ b/R/geom-icon.R @@ -1,3 +1,191 @@ +# CanvasLength: the length of the canvas in numeric +# CanvasHeight: the height of the canvas in numeric +# NumberOfIcon: number of icon for each group in vector +# NumberOfGroup: number of groups in integer, default 1 +# connected: whether different groups of icon is connected in boolean, default false +arrangement = function(CanvasLength, CanvasHeight, NumberOfIcon, NumberOfGroups=1, connected=FALSE, ratio=1.0) { + + # color vector + color = c("blue", "green", "yellow", "red", "gray") + + # return empty list if one of height, length and number of groups is invalid + if (CanvasHeight <= 0 || CanvasLength <= 0 || NumberOfGroups <= 0) { + return(list()) + } + + # return empty list if number of icon does not match number of groups + if (length(NumberOfIcon) != NumberOfGroups) { + return(list()) + } + + # return empty list if number of icon is invalid + for (x in NumberOfIcon) { + if (x <= 0) { + return(list()) + } + } + + # return empty list if more than 5 colors are needed + if (NumberOfGroups > 5) { + return(list()) + } + + # swap height and length then make the recursive call if height is larger than length + if (CanvasHeight > CanvasLength) { + result = arrangement(CanvasHeight, CanvasLength, NumberOfIcon, NumberOfGroups, connected, ratio) + for (i in seq(1, length(result))) { + temp = result[[i]][1] + result[[i]][1] = result[[i]][2] + result[[i]][2] = temp + } + return(result) + } + + if (NumberOfGroups == 1) { + + # case 1: only one group + NumberOfIcon = NumberOfIcon[1] + + # simply return the center of the canvas if there's onlyh one icon + if (NumberOfIcon == 1) { + return(list(c(CanvasLength / 2, CanvasHeight / 2, color[1]))) + } + + # create a vector holding the differences between the length and height of icon for different icon arrangements + differences = c() + for (i in seq(ceiling(sqrt(NumberOfIcon)), NumberOfIcon)) { + differences = c(differences, abs(CanvasHeight / ceiling(NumberOfIcon / i) - CanvasLength / i)) + } + + # choose the arrangement that has the smallest differences in icon length and height + iconPerLine = which(differences == min(differences))[1] + iconPerLine = iconPerLine + ceiling(sqrt(NumberOfIcon)) - 1 + iconSizeHorizontal = CanvasLength / iconPerLine + iconSizeVertical = CanvasHeight / ceiling(NumberOfIcon / iconPerLine) + iconSize = min(c(iconSizeVertical, iconSizeHorizontal)) * ratio + + # create list to return using the selected arrangement + x = 1 + y = 1 + index = 1 + result = list() + while(index <= NumberOfIcon) { + result[[index]] = c((x - 1/2) * iconSizeHorizontal, (y - 1/2) * iconSizeVertical, color[1], iconSize) + index = index + 1 + x = x + 1 + if (x > iconPerLine) { + x = 1 + y = y + 1 + } + } + return(result) + + } else { + + # case 2: multiple group but connected + if (connected) { + + # recursive call as if all groups are one large group + result = arrangement(CanvasLength, CanvasHeight, c(sum(NumberOfIcon)), 1, FALSE, ratio) + + # change colors in the return value above to make sure different group has different color + index = NumberOfIcon[1] + for (i in seq(2, NumberOfGroups)) { + for (j in seq(1, NumberOfIcon[i])) { + result[[index + j]][3] = color[i] + } + index = index + NumberOfIcon[i] + } + return(result) + + } else { + + # case 3: multiple group not connected + # create a vector holding the differences between the length and height of icon for different icon arrangements + differences = c() + for (i in seq(1, max(NumberOfIcon))) { + iconHolderPerLine = sum(ceiling(NumberOfIcon / i)) + NumberOfGroups - 1 + differences = c(differences, abs(CanvasHeight / i - CanvasLength / iconHolderPerLine)) + } + + # choose the arrangement that has the smallest differences in icon length and height + iconHolderPerVerticalLine = which(differences == min(differences))[1] + iconSizeVertical = CanvasHeight / iconHolderPerVerticalLine + iconSizeHorizontal = CanvasLength / (sum(ceiling(NumberOfIcon / iconHolderPerVerticalLine)) + NumberOfGroups - 1) + iconSize = min(c(iconSizeVertical, iconSizeHorizontal)) * ratio + + # create list to return using the selected arrangement + x = 1 + y = 0 + index = 0 + result = list() + for (i in seq(1, NumberOfGroups)) { + for (j in seq(1, NumberOfIcon[i])) { + index = index + 1 + y = y + 1 + if (y > iconHolderPerVerticalLine) { + x = x + 1 + y = 1 + } + result[[index]] = c((x - 1/2) * iconSizeHorizontal, (y - 1/2) * iconSizeVertical, color[i], iconSize) + } + x = x + 2 + y = 0 + } + return(result) + } + } + + # return empty list if the code fails somehow + return(list()) +} + +icon_grob = function(data, num_of_icon, num_of_group, connected, canvas_length, canvas_height, ratio, + name = NULL, gp = gpar(), vp = NULL) { + + gTree( + data = data, num_of_icon = num_of_icon, num_of_group = num_of_group, connected = connected, + canvas_length = canvas_length, canvas_height = canvas_height, ratio = ratio, name = name, gp = gp, vp = vp, cl = "icon_grob" + ) +} + +#' @import grid +#' @export +makeContent.icon_grob = function(x) { + + # print(1 / convertUnit(unit(1, 'inches'), 'native', valueOnly = TRUE)) + # print(1 / convertUnit(unit(1, 'inches'), 'native', axisFrom = "y", valueOnly = TRUE)) + data = x$data + canvas_length = 1 / convertUnit(unit(1, 'inches'), 'native', valueOnly = TRUE) + canvas_height = 1 / convertUnit(unit(1, 'inches'), 'native', axisFrom = "y", valueOnly = TRUE) + # canvas_length = convertUnit(unit(1, 'npc'), 'native', valueOnly = TRUE) + # canvas_height = convertUnit(unit(0, 'npc'), 'native', axisFrom = "y", valueOnly = TRUE) + num_of_icon = x$num_of_icon + num_of_group = x$num_of_group + connected = x$connected + + result = arrangement(canvas_length, canvas_height, NumberOfIcon = num_of_icon, + NumberOfGroups = num_of_group, connected = connected, x$ratio) + + x_vals = c() + y_vals = c() + cols = c() + for (i in seq(length(result))) + { + x_vals = append(x_vals, as.double(result[[i]][1]) / canvas_length) + y_vals = append(y_vals, as.double(result[[i]][2]) / canvas_height) + cols = append(cols, result[[i]][3]) + } + + grobSize = as.double(result[[1]][4]) / 2 / canvas_height + + # print(x_vals) + # print(y_vals) + # print(grobSize) + + circleGrob(x_vals, y_vals, grobSize, default.units = "native", gp = x$gp) +} + #' @export geom_icon <- function(mapping = NULL, @@ -10,7 +198,8 @@ geom_icon <- function(mapping = NULL, show.legend = NA, inherit.aes = TRUE, offset = 0.01, - prob.struct = NULL){ + prob.struct = NULL + ){ # same as in geom_bloc # parse prob structure @@ -64,17 +253,53 @@ geom_icon <- function(mapping = NULL, #' @importFrom grid pointsGrob #' @importFrom grid gpar #' @importFrom ggplot2 aes -GeomIcon <- ggplot2::ggproto("GeomIcon", ggplot2::GeomPoint, +GeomIcon <- ggplot2::ggproto("GeomIcon", ggplot2::Geom, required_aes = c("x", "y"), non_missing_aes = c("size", "shape", "colour"), default_aes = ggplot2::aes( shape = 16, colour = "gray", size = 10, fill = NA, - alpha = NA, stroke = 0.5 + alpha = NA, stroke = 0.5, ratio = 1.0 ), setup_data = function(data, params) { #browser() data + }, + + draw_panel = function(self, data, panel_params, coord, na.rm = FALSE) { + coords <- coord$transform(data, panel_params) + str(coords) + + # assuming the first row of the data is cyl + vec = unlist(coords[1]) + + # browser() + + canvas_length = convertUnit(unit(1, 'npc'), 'native', valueOnly = TRUE) + canvas_height = convertUnit(unit(0, 'npc'), 'native', axisFrom = "y", valueOnly = TRUE) + + group_input = length(levels(as.factor(vec))) + icon_input = rep(0, length(levels(as.factor(vec)))) + for (i in seq(length(levels(as.factor(vec))))) { + icon_input[i] = length(which(vec == as.numeric(levels(vec)[i]))) + } + + result = arrangement(canvas_length, canvas_height, NumberOfIcon = icon_input, + NumberOfGroups = group_input, connected = FALSE, ratio = coords$ratio[1]) + + x_vals = c() + y_vals = c() + cols = c() + for (i in seq(length(result))) + { + x_vals = append(x_vals, as.double(result[[i]][1]) / canvas_length) + y_vals = append(y_vals, as.double(result[[i]][2]) / canvas_height) + cols = append(cols, result[[i]][3]) + } + + # pointsGrob(x_vals, y_vals, default.units = "native", gp = gpar(col = cols, lwd = 2)) + icon_grob(data = vec, num_of_icon = icon_input, num_of_group = group_input, + connected = FALSE, canvas_length, canvas_height, coords$ratio[1], gp = gpar(fill = cols)) } diff --git a/algorithm.R b/algorithm.R new file mode 100644 index 0000000..f96ba2c --- /dev/null +++ b/algorithm.R @@ -0,0 +1,139 @@ +# CanvasLength: the length of the canvas in numeric +# CanvasHeight: the height of the canvas in numeric +# NumberOfIcon: number of icon for each group in vector +# NumberOfGroup: number of groups in integer, default 1 +# connected: whether different groups of icon is connected in boolean, default false +arrangement = function(CanvasLength, CanvasHeight, NumberOfIcon, NumberOfGroups=1, connected=FALSE) { + + # color vector + color = c("blue", "green", "yellow", "red", "gray") + + # return empty list if one of height, length and number of groups is invalid + if (CanvasHeight <= 0 || CanvasLength <= 0 || NumberOfGroups <= 0) { + return(list()) + } + + # return empty list if number of icon does not match number of groups + if (length(NumberOfIcon) != NumberOfGroups) { + return(list()) + } + + # return empty list if number of icon is invalid + for (x in NumberOfIcon) { + if (x <= 0) { + return(list()) + } + } + + # return empty list if more than 5 colors are needed + if (NumberOfGroups > 5) { + return(list()) + } + + # swap height and length then make the recursive call if height is larger than length + if (CanvasHeight > CanvasLength) { + result = arrangement(CanvasHeight, CanvasLength, NumberOfIcon, NumberOfGroups, connected) + for (i in seq(1, length(result))) { + temp = result[[i]][1] + result[[i]][1] = result[[i]][2] + result[[i]][2] = temp + } + return(result) + } + + if (NumberOfGroups == 1) { + + # case 1: only one group + NumberOfIcon = NumberOfIcon[1] + + # simply return the center of the canvas if there's onlyh one icon + if (NumberOfIcon == 1) { + return(list(c(CanvasLength / 2, CanvasHeight / 2, color[1]))) + } + + # create a vector holding the differences between the length and height of icon for different icon arrangements + differences = c() + for (i in seq(ceiling(sqrt(NumberOfIcon)), NumberOfIcon)) { + differences = c(differences, abs(CanvasHeight / ceiling(NumberOfIcon / i) - CanvasLength / i)) + } + + # choose the arrangement that has the smallest differences in icon length and height + iconPerLine = which(differences == min(differences))[1] + iconPerLine = iconPerLine + ceiling(sqrt(NumberOfIcon)) - 1 + iconSizeHorizontal = CanvasLength / iconPerLine + iconSizeVertical = CanvasHeight / ceiling(NumberOfIcon / iconPerLine) + + # create list to return using the selected arrangement + x = 1 + y = 1 + index = 1 + result = list() + while(index <= NumberOfIcon) { + result[[index]] = c((x - 1/2) * iconSizeHorizontal, (y - 1/2) * iconSizeVertical, color[1]) + index = index + 1 + x = x + 1 + if (x > iconPerLine) { + x = 1 + y = y + 1 + } + } + return(result) + + } else { + + # case 2: multiple group but connected + if (connected) { + + # recursive call as if all groups are one large group + result = arrangement(CanvasLength, CanvasHeight, c(sum(NumberOfIcon)), 1, FALSE) + + # change colors in the return value above to make sure different group has different color + index = NumberOfIcon[1] + for (i in seq(2, NumberOfGroups)) { + for (j in seq(1, NumberOfIcon[i])) { + result[[index + j]][3] = color[i] + } + index = index + NumberOfIcon[i] + } + return(result) + + } else { + + # case 3: multiple group not connected + # create a vector holding the differences between the length and height of icon for different icon arrangements + differences = c() + for (i in seq(1, max(NumberOfIcon))) { + iconHolderPerLine = sum(ceiling(NumberOfIcon / i)) + NumberOfGroups - 1 + differences = c(differences, abs(CanvasHeight / i - CanvasLength / iconHolderPerLine)) + } + + # choose the arrangement that has the smallest differences in icon length and height + iconHolderPerVerticalLine = which(differences == min(differences))[1] + iconSizeVertical = CanvasHeight / iconHolderPerVerticalLine + iconSizeHorizontal = CanvasLength / (sum(ceiling(NumberOfIcon / iconHolderPerVerticalLine)) + NumberOfGroups - 1) + + # create list to return using the selected arrangement + x = 1 + y = 0 + index = 0 + result = list() + for (i in seq(1, NumberOfGroups)) { + for (j in seq(1, NumberOfIcon[i])) { + index = index + 1 + y = y + 1 + if (y > iconHolderPerVerticalLine) { + x = x + 1 + y = 1 + } + result[[index]] = c((x - 1/2) * iconSizeHorizontal, (y - 1/2) * iconSizeVertical, color[i]) + } + x = x + 2 + y = 0 + } + return(result) + } + } + + # return empty list if the code fails somehow + return(list()) +} diff --git a/tests/figs/test-dw/mpg-plot.svg b/tests/figs/test-dw/mpg-plot.svg new file mode 100644 index 0000000..66da721 --- /dev/null +++ b/tests/figs/test-dw/mpg-plot.svg @@ -0,0 +1,72 @@ + + + + + + + + + + + + + + + + + + + + + + +4 +6 +8 +10 + + + + + + + + + + +10 +15 +20 +25 +30 +35 +x +y + + +4 +5 +6 +7 +8 +cyl + + + + + + + + + + +mpg_plot + diff --git a/tests/selftest.Rmd b/tests/selftest.Rmd new file mode 100644 index 0000000..174e807 --- /dev/null +++ b/tests/selftest.Rmd @@ -0,0 +1,75 @@ +--- +title: "Untitled" +author: "Daniel Wang" +date: "11/11/2020" +output: html_document +--- + +```{r} +devtools::load_all(".") +library(tidyverse) +library(ggplot2) +# library(pgog) +data(mpg) +ggplot(mtcars) + + geom_bloc(aes(x = c(mpg), height = c(P(mpg | cyl)), y = c(cyl), fill = cyl)) +``` + + +```{r} +library(testthat) +usethis::use_testthat() +library(stringr) + +test_that("str_length is number of characters", { + expect_equal(str_length("a"), 1) + expect_equal(str_length("ab"), 2) + expect_equal(str_length("abc"), 3) +}) + +string <- "Testing is fun!" +test_that("tests for string", {expect_match(string, "Testing") +expect_match(string, "testing") +expect_match(string, "testing", ignore.case = TRUE)}) +``` + + +```{r} +test_that("parsing things connect to ggplot", { +obj <- ggplot(mtcars) + + geom_bloc(aes(x = c(mpg), height = c(P(mpg | cyl)), y = c(cyl), fill = cyl)) +expect_null(obj) +}) +``` + +```{r} +data(cancer) + +disp_x_height <- cancer %>% + ggplot() + + geom_icon(aes(x = factor(test), + height = P(cancer), + color = cancer, + size = 10 + ), position = "array") +vdiffr::expect_doppelganger("x = A, height = P(A), array", disp_x_height) + +rlang::last_error() +``` + +```{r} +vdiffr::manage_cases() +``` +```{r} +test_that("plots have known output", { + # disp_hist_base <- function() hist(mtcars$disp) + # expect_doppelganger("disp-histogram-base", disp_hist_base) + + # disp_hist_ggplot <- ggplot(mtcars, aes(disp)) + geom_histogram() + # expect_doppelganger("disp-histogram-ggplot", disp_hist_ggplot) + + mpg_plot <- ggplot(mtcars) + geom_bloc(aes(x = c(mpg), height = c(P(mpg | cyl)), y = c(cyl), fill = cyl)) + expect_doppelganger("mpg_plot", mpg_plot) +}) +``` + diff --git a/tests/testthat/test-dw.R b/tests/testthat/test-dw.R new file mode 100644 index 0000000..9cba906 --- /dev/null +++ b/tests/testthat/test-dw.R @@ -0,0 +1,15 @@ +context("test-dw") +library(rlang) +library(tidyverse) +library(vdiffr) + +test_that("test for the order of the plot", { + # disp_hist_base <- function() hist(mtcars$disp) + # expect_doppelganger("disp-histogram-base", disp_hist_base) + + # disp_hist_ggplot <- ggplot(mtcars, aes(disp)) + geom_histogram() + # expect_doppelganger("disp-histogram-ggplot", disp_hist_ggplot) + + color_order_plot <- ggplot(mtcars) + geom_bloc(aes(x = c(mpg), height = c(P(mpg | cyl)), y = c(cyl), fill = cyl)) + expect_doppelganger("mpg_plot", color_order_plot) +}) diff --git a/tests/testthat/test-fill-order.R b/tests/testthat/test-fill-order.R new file mode 100644 index 0000000..9afbd42 --- /dev/null +++ b/tests/testthat/test-fill-order.R @@ -0,0 +1,15 @@ +context("test-dw") +library(rlang) +library(tidyverse) +library(vdiffr) + +test_that("plots have known output", { + # disp_hist_base <- function() hist(mtcars$disp) + # expect_doppelganger("disp-histogram-base", disp_hist_base) + + # disp_hist_ggplot <- ggplot(mtcars, aes(disp)) + geom_histogram() + # expect_doppelganger("disp-histogram-ggplot", disp_hist_ggplot) + + fill_order_plot <- ggplot(mtcars) + geom_bloc(aes(x = c(mpg), height = c(P(mpg | cyl)), y = c(cyl), fill = cyl)) + expect_doppelganger("fill_order_plot", fill_order_plot) +}) diff --git a/vignettes/pgog.Rmd b/vignettes/pgog.Rmd index e553b36..cee7d2b 100644 --- a/vignettes/pgog.Rmd +++ b/vignettes/pgog.Rmd @@ -53,7 +53,6 @@ colorbrewer2 <- rev(c( "#0868ac", "#084081")) - colorbrewer2_warm <- rev(c( "#ffffb2", "#fecc5c",