mirror/brickr
1
0
Fork 0
mirror of https://github.com/ryantimpe/brickr.git synced 2026-01-05 21:29:33 -06:00
Code Issues Packages Projects Releases Wiki Activity

Bunch of minor fixes:

Browse Source 
* Again, better detection for flipped coords
* Luminance calculation to determine if brick should have white or grey details.
* More documentation
This commit is contained in:
Ryan Timpe
2019-07-20 13:53:57 -04:00
parent f93756f0e2
commit 70b159de1e
20 changed files with 195 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@@ -64,3 +64,4 @@ forestmovie.mp4
forestweb.mp4
test_*
brickr.Rproj
brickr_colors.png

BIN
Colors/Colors_Master.xlsx
View File

Binary file not shown.

5
Colors/color_rendering.R
View File

@@ -19,6 +19,9 @@ lego_colors <- color_df %>%
mutate_at(vars(R_lego, G_lego, B_lego), list(~./255)) %>%
arrange(Palette, LEGONo) %>%
mutate(brickrID = row_number()) %>%
select(brickrID, Color, LEGONo, Palette, everything())
select(brickrID, Color, LEGONo, Palette, everything()) %>%
#Calculate brightness of color
# https://stackoverflow.com/questions/596216/formula-to-determine-brightness-of-rgb-color
mutate(lum = 0.299*R_lego + 0.587*G_lego + 0.114*B_lego)
usethis::use_data(lego_colors, overwrite = T)

1
DESCRIPTION
View File

@@ -29,6 +29,7 @@ Collate:
'bricks_from_data.R'
'bricks_to_3d.R'
'collect_bricks.R'
'colors-and-themes.R'
'coord_brick.R'
'draw_key.R'
'geom_brick.R'

3
NAMESPACE
View File

@@ -5,9 +5,12 @@ export(CoordBrick)
export(CoordBrickFlip)
export(GeomBrick)
export(GeomBrickCol)
export(brick_colors)
export(bricks_from_coords)
export(bricks_from_excel)
export(bricks_from_table)
export(build_instructions)
export(build_mosaic)
export(collect_3d)
export(collect_bricks)
export(convert_to_match_color)

1
NEWS.md
View File

@@ -1,6 +1,7 @@
# brickr 0.1.0.0000
* **Breaking:** Data "lego_colors.rda" has been updated with more accurate RGB values and new `brickrID` numbers. This will impact previously created mosaics and 3D models.
* **Breaking:** Pretty much every function name.
**Mosaics**

84
R/colors-and-themes.R Normal file
View File

@@ -0,0 +1,84 @@
#' Available brick colors
#'
#' Generates a plot of available brick colors. Use .names_only = TRUE to get a list of color names.
#' @param .names_only Return an array of the 39 brick color names. Does not plot.
#' @return A table and ggplot of brick colors & ID numbers.
#' @examples
#' #Generate plot of colors
#' brick_colors()
#'
#' #Print list of colors
#' brick_colors(TRUE)
#' @export
#'
brick_colors <- function(.names_only = FALSE){
if(.names_only){
return(lego_colors$Color)
}
message("Use View(lego_colors) to see these in a table format.")
tidyr::crossing(x=1:2, y=1:2, color = lego_colors$Color) %>%
dplyr::left_join(lego_colors %>% dplyr::select(color = Color, color_hex = hex), by = "color") %>%
dplyr::mutate(color = factor(gsub(" ", "\n", color),
levels = gsub(" ", "\n", lego_colors$Color))) %>%
ggplot2::ggplot(aes(x=x, y=y, group=color)) +
ggplot2::labs(title = "Brick colors available in {brickr}") +
geom_brick_rect(aes(fill = color_hex), label_scale = 0.1) +
ggplot2::coord_fixed(x=c(0.5, 2.5), y=c(0.5, 2.5)) +
ggplot2::scale_fill_identity() +
ggplot2::facet_wrap(~color, ncol = 9) +
ggplot2::theme_void()
}
#' @export
#' @rdname brick_colors
#'
display_colors <- function(...){
warning("display_colors() is deprecated. Please use brick_colors()")
brick_colors(...)
}
#' Available brick themes for scale_fill_brick()
#'
#' Generates a plot of available brick themes.
#' @param .names_only Return an array of the 39 brick color names. Does not plot.
#' @return A table and ggplot of brick colors & ID numbers.
#' @examples
#' #Generate plot of colors
#' brick_colors()
#'
#' #Print list of colors
#' brick_colors(TRUE)
#' @export
#'
brick_themes <- function(show_themes = "all"){
if(show_themes == "all" | !any(show_themes %in% brickr_themes$theme)){
thms <- brickr_themes$theme
} else {
thms <- show_themes
}
dat <- brickr_themes %>%
dplyr::filter(theme %in% thms) %>%
dplyr::group_by(theme) %>%
dplyr::mutate(y = 5 - as.numeric(cut(dplyr::row_number(), 4)),
x = dplyr::row_number()) %>%
dplyr::ungroup()
max(dat$x)
dat %>%
dplyr::filter(TYPE == "color") %>%
ggplot2::ggplot(ggplot2::aes(x=x, y=y)) +
ggplot2::geom_rect(aes(fill = hex),
xmin = 0, xmax = max(dat$x), ymin = 0, ymax = 4,
data = dat %>% dplyr::filter(TYPE == "plot")) +
geom_brick_col(ggplot2::aes(fill = hex), two_knob = F) +
ggplot2::scale_fill_identity() +
# ggplot2::scale_x_reverse() +
coord_brick() +
ggplot2::facet_wrap(~theme) +
# ggplot2::theme_void() +
NULL
}

8
R/coord_brick.R
View File

@@ -12,6 +12,10 @@
#' coord_brick()
#'
#' #horizontal bars
#' ggplot(df, aes(trt, outcome)) +
#' geom_brick_col(aes(fill = trt)) +
#' coord_brick_flip()
#'
#' @export
#' @rdname coord_brick
coord_brick <- function(xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") {
@@ -36,7 +40,7 @@ coord_brick_flip <- function(xlim = NULL, ylim = NULL, expand = TRUE, clip = "on
#' @usage NULL
#' @export
CoordBrick <- ggproto("CoordBrick", CoordCartesian,
# is_free = function() FALSE,
is_free = function() FALSE,
is_flipped = function() FALSE,
aspect = function(self, ranges) {
1
@@ -47,7 +51,7 @@ CoordBrick <- ggproto("CoordBrick", CoordCartesian,
#' @export
CoordBrickFlip <- ggproto("CoordBrickFlip", CoordCartesian,
is_linear = function() "flipped",
is_flipped = function() TRUE,
transform = function(data, panel_params) {
data <- ggplot2:::flip_labels(data)

10
R/draw_key.R
View File

@@ -1,11 +1,13 @@
#' @export
#' @rdname geom_brick_rect
#' @rdname brickr-ggproto
draw_key_brick <- function(data, params, size) {
#Outline and text for dark colors
data$color_intensity <- as.numeric(colSums(col2rgb(data$fill)))
data$text_alpha <- ifelse(data$color_intensity <= 300, 0.3, 0.3)
data$text_col <- ifelse(data$color_intensity <= 300, "#CCCCCC", "#333333")
color_lum <- as.data.frame(t(col2rgb(data$fill)/255))
data$color_intensity <- 0.299*color_lum$red + 0.587*color_lum$green + 0.114*color_lum$blue
data$text_alpha <- ifelse(data$color_intensity <= thres_brick_lum(), 0.3, 0.3)
data$text_col <- ifelse(data$color_intensity <= thres_brick_lum(), "#CCCCCC", "#333333")
grid::grobTree(
grid::rectGrob(gp = grid::gpar(col = alpha(data$colour %||% "#333333", 0.3),

25
R/geom_brick.R
View File

@@ -6,7 +6,7 @@
geom_brick_rect <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
label = "LEGO", simplified_threshold = 24*24,
label = "brickr", simplified_threshold = 24*24, label_scale = 1,
linejoin = "mitre",
na.rm = FALSE,
show.legend = NA,
@@ -22,6 +22,7 @@ geom_brick_rect <- function(mapping = NULL, data = NULL,
params = list(
linejoin = linejoin,
label = label,
label_scale = label_scale,
na.rm = na.rm,
simplified_threshold = simplified_threshold,
...
@@ -40,8 +41,8 @@ geom_brick_rect <- function(mapping = NULL, data = NULL,
#' @usage NULL
#' @export
GeomBrick <- ggproto("GeomBrick", Geom,
default_aes = aes(colour = "#333333", fill = "#C4281B", size = 0.5, linetype = 1,
alpha = NA, label = "LEGO",
default_aes = aes(colour = "#333333", fill = "#B40000", size = 0.5, linetype = 1,
alpha = NA, label = "brickr", label_scale = 1,
angle = 0, family = "", fontface = 1, lineheight = 1.2),
required_aes = c("x", "y"),
@@ -52,7 +53,7 @@ GeomBrick <- ggproto("GeomBrick", Geom,
},
draw_panel = function(self, data, panel_params, coord, linejoin = "mitre",
simplified_threshold = 24*24) {
simplified_threshold = 24*24, label_scale = 1) {
#This happens to EACH panel
if (!coord$is_linear()) {
@@ -66,8 +67,8 @@ GeomBrick <- ggproto("GeomBrick", Geom,
data$Level <- as.numeric(data$PANEL)
if(is.null(data$fill)){
data$Lego_name <- "#C4281B"
data$Lego_color <- "#C4281B"
data$Lego_name <- "#B40000"
data$Lego_color <- "#B40000"
}else{
data$Lego_name <- data$fill
data$Lego_color <- data$fill
@@ -121,9 +122,11 @@ GeomBrick <- ggproto("GeomBrick", Geom,
function(y) y - y_size*(5/8)*(1/2)*(1/4))
#Outline and text for dark colors
coords$color_intensity <- as.numeric(colSums(col2rgb(coords$fill)))
coords$text_alpha <- ifelse(coords$color_intensity <= 300, 0.2, 0.2)
coords$text_col <- ifelse(coords$color_intensity <= 300, "#CCCCCC", "#333333")
color_lum <- as.data.frame(t(col2rgb(coords$fill)/255))
coords$color_intensity <- 0.299*color_lum$red + 0.587*color_lum$green + 0.114*color_lum$blue
coords$text_alpha <- ifelse(coords$color_intensity <= thres_brick_lum(), 0.3, 0.3)
coords$text_col <- ifelse(coords$color_intensity <= thres_brick_lum(), "#CCCCCC", "#333333")
gm_knob_shadow <- grid::circleGrob(
coords_nudge$x,
@@ -154,7 +157,7 @@ GeomBrick <- ggproto("GeomBrick", Geom,
#Text ----
#Don't draw if mosaic is larger than threshold size
n <- nrow(data)
if (n > simplified_threshold ) {
if (n > simplified_threshold | data$label[1] == "") {
gm_knob_text <- grid::nullGrob()
} else {
lab <- data$label
@@ -178,7 +181,7 @@ GeomBrick <- ggproto("GeomBrick", Geom,
gp = grid::gpar(
col = alpha(coords$text_col, coords$text_alpha),
fontsize = fs,
cex = (3/8) * 0.5 * (1.5) * ((100/n)^(1/2)), #100 bricks is optimal size for labels by default?
cex = label_scale * (3/8) * 0.5 * (1.5) * ((100/n)^(1/2)), #100 bricks is optimal size for labels by default?
fontfamily = data$family,
fontface = "bold",
lineheight = data$lineheight

33
R/geom_brick_col.R
View File

@@ -63,7 +63,7 @@ geom_brick_col <- function(mapping = NULL, data = NULL,
#' @export
#' @include geom_brick.R
GeomBrickCol <- ggproto("GeomCol", GeomBrick,
default_aes = aes(colour = "#333333", fill = "#C4281B", size = 0.25, linetype = 1,
default_aes = aes(colour = "#333333", fill = "#B40000", size = 0.25, linetype = 1,
alpha = NA, label = "brickr",
angle = 0, family = "", fontface = 1, lineheight = 1.2),
required_aes = c("x", "y"),
@@ -102,7 +102,8 @@ GeomBrickCol <- ggproto("GeomCol", GeomBrick,
colour = data$colour[1], alpha = data$alpha[1])
#Reverse calc for flipped
if(coord$is_linear() == "flipped"){
if(!is.null(coord$is_flipped) && coord$is_flipped()){
coords_rect <- flip_coords(coords_rect)
}
@@ -168,11 +169,15 @@ GeomBrickCol <- ggproto("GeomCol", GeomBrick,
# test_coords_rect4 <<- coords_rect
#Brighter colors for darker bricks
coords_rect$color_intensity <- as.numeric(colSums(col2rgb(coords_rect$fill)))
coords_rect$outline_col <- ifelse(coords_rect$color_intensity <= 300, "#CCCCCC", "#333333")
#Calculate brightness of color
# https://stackoverflow.com/questions/596216/formula-to-determine-brightness-of-rgb-color
color_lum <- as.data.frame(t(col2rgb(coords_rect$fill)/255))
coords_rect$color_intensity <- 0.299*color_lum$red + 0.587*color_lum$green + 0.114*color_lum$blue
coords_rect$outline_col <- ifelse(coords_rect$color_intensity <= thres_brick_lum(), "#CCCCCC", "#333333")
#Un-Reverse calc for flipped coords
if(coord$is_linear() == "flipped"){
if(!is.null(coord$is_flipped) && coord$is_flipped()){
coords_rect <- flip_coords(coords_rect)
}
@@ -198,7 +203,7 @@ GeomBrickCol <- ggproto("GeomCol", GeomBrick,
# coords_knobs0 <<- coords
#Reverse calc for flipped
if(coord$is_linear() == "flipped"){
if(!is.null(coord$is_flipped) && coord$is_flipped()){
coords <- flip_coords(coords)
}
@@ -231,12 +236,14 @@ GeomBrickCol <- ggproto("GeomCol", GeomBrick,
# coords_knobs1 <<- coords_knobs
#Outline and text for dark colors
coords_knobs$color_intensity <- as.numeric(colSums(col2rgb(coords_knobs$fill)))
coords_knobs$text_alpha <- ifelse(coords_knobs$color_intensity <= 300, 0.3, 0.3)
coords_knobs$text_col <- ifelse(coords_knobs$color_intensity <= 300, "#CCCCCC", "#333333")
color_lum <- as.data.frame(t(col2rgb(coords_knobs$fill)/255))
coords_knobs$color_intensity <- 0.299*color_lum$red + 0.587*color_lum$green + 0.114*color_lum$blue
coords_knobs$text_alpha <- ifelse(coords_knobs$color_intensity <= thres_brick_lum(), 0.3, 0.3)
coords_knobs$text_col <- ifelse(coords_knobs$color_intensity <= thres_brick_lum(), "#CCCCCC", "#333333")
#Un-Reverse calc for flipped
if(coord$is_linear() == "flipped"){
if(!is.null(coord$is_flipped) && coord$is_flipped()){
coords_knobs <- flip_coords_xy(coords_knobs)
}
@@ -332,4 +339,8 @@ flip_coords_xy <- function(dat){
dat$z <- NULL
return(dat)
}
}
thres_brick_lum <- function(){
return(0.4)
}

2
R/geom_brick_point.R
View File

@@ -73,7 +73,7 @@ geom_brick_point <- function(mapping = NULL, data = NULL,
#' @rdname brickr-ggproto
GeomStud <- ggproto("GeomStud", Geom,
required_aes = c("x", "y"),
default_aes = aes(colour = "#333333", fill = "#C4281B", size = 1, linetype = 1,
default_aes = aes(colour = "#333333", fill = "#B40000", size = 1, linetype = 1,
alpha = NA),
draw_panel = function(data, panel_params, coord, na.rm = FALSE,

29
R/image_to_colors.R
View File

@@ -60,32 +60,3 @@ legoize <- function(image_list, color_table = lego_colors, theme = "default", co
return(in_list)
}
#' Display a table and plot of possible brick colors & their ID numbers
#' @param .names_only Return an array of the 39 brick color names. Does not plot.
#' @return A table and ggplot of brick colors & ID numbers.
#' @export
#'
display_colors <- function(.names_only = FALSE){
if(.names_only){
return(lego_colors$Color)
}
message("Use View(lego_colors) to see these in a table format.")
lego_colors %>%
dplyr::mutate(Label = paste0(brickrID, "\n", Color)) %>%
ggplot2::ggplot(ggplot2::aes(x = brickrID %% 6, y = (6 - (brickrID %/% 6)))) +
ggplot2::geom_tile(ggplot2::aes(fill = hex),color = "white", size = 2) +
ggplot2::scale_fill_identity() +
ggplot2::geom_label(ggplot2::aes(label = Label)) +
ggplot2::labs(title = "Brick Colors by {brickr} ID# and LEGO Name",
subtilte = "See included data frame 'lego_colors'") +
ggplot2::theme_minimal() +
ggplot2::theme( panel.background = ggplot2::element_rect(fill = "#7EC0EE"),
strip.background = ggplot2::element_rect(fill = "#F7F18D"),
strip.text = ggplot2::element_text(color = "#333333", face = "bold"),
axis.line = ggplot2::element_blank(),
axis.title.x = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.title.y = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank())
}

42
R/view_image.R
View File

@@ -5,26 +5,20 @@
#' @export
#'
display_set <- function(image_list, title=NULL){
build_mosaic <- function(image_list, title=NULL){
in_list <- image_list
image <- in_list$Img_bricks
type <- in_list$mosaic_type
coord_x <- c(min(image$xmin)+0.5, max(image$xmax)-0.5)
coord_y <- c(min(image$ymin)+0.5, max(image$ymax)-0.5)
#FLat mosaics use the new geom_brick_rect, which looks for individual x and ys out of $Img_lego
if(type == "flat"){
img <- ggplot2::ggplot(in_list$Img_lego, ggplot2::aes(x=x, y=y)) +
geom_brick_rect(ggplot2::aes(fill = Lego_color), color = "#333333")+
ggplot2::scale_fill_identity() +
ggplot2::coord_fixed(expand = 0.5)
} else {
img <- ggplot2::ggplot(image) +
gplot2::geom_rect(ggplot2::aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax,
fill = Lego_color), color = "#333333")
ggplot2::coord_fixed(ratio = 6/5, expand = FALSE)
}
if(type == "stacked") stop("Stacked mosaics have been removed from brickr. Only flat / 'knobs-up' mosaics are supported.")
img <- ggplot2::ggplot(in_list$Img_lego, ggplot2::aes(x=x, y=y)) +
geom_brick_rect(ggplot2::aes(fill = Lego_color), color = "#333333")+
ggplot2::scale_fill_identity() +
ggplot2::coord_fixed(expand = 0.5)
img <- img +
ggplot2::labs(title = title) +
@@ -33,6 +27,14 @@ display_set <- function(image_list, title=NULL){
return(img)
}
#' @export
#' @rdname build_mosaic
display_set <- function(...){
warning("display_set() is deprecated. Please use build_mosaic()")
build_mosaic(...)
}
#' Create instruction manual for 2D image mosaics
#'
#' @param image_list List output from collect_bricks() or image_to_bricks(). Contains an element \code{Img_lego}.
@@ -40,7 +42,7 @@ display_set <- function(image_list, title=NULL){
#' @export
#'
generate_instructions <- function(image_list, num_steps=6) {
build_instructions <- function(image_list, num_steps=6) {
in_list <- image_list
image <- in_list$Img_bricks
type <- in_list$mosaic_type
@@ -75,7 +77,7 @@ generate_instructions <- function(image_list, num_steps=6) {
dplyr::bind_rows() %>%
ggplot2::ggplot() +
ggplot2::geom_rect(ggplot2::aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax,
fill = Lego_color), color = "#333333") +
fill = Lego_color), color = "#333333") +
ggplot2::scale_fill_identity() +
ggplot2::coord_fixed(ratio = coord_ratio, expand = FALSE) +
ggplot2::facet_wrap(~Step) +
@@ -89,3 +91,11 @@ generate_instructions <- function(image_list, num_steps=6) {
axis.title.y = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank())
}
#' @export
#' @rdname build_instructions
generate_instructions <- function(...){
warning("generate_instructions() is deprecated. Please use build_instructions()")
build_instructions(...)
}

BIN
data/lego_colors.rda
View File

Binary file not shown.

9
man/display_colors.Rd → man/brick_colors.Rd
View File

@@ -1,10 +1,13 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/image_to_colors.R
\name{display_colors}
% Please edit documentation in R/colors-and-themes.R
\name{brick_colors}
\alias{brick_colors}
\alias{display_colors}
\title{Display a table and plot of possible brick colors & their ID numbers}
\usage{
display_colors(.names_only = FALSE)
brick_colors(.names_only = FALSE)
display_colors(...)
}
\arguments{
\item{.names_only}{Return an array of the 39 brick color names. Does not plot.}

5
man/brickr-ggproto.Rd
View File

@@ -1,10 +1,11 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/coord_brick.R, R/geom_brick.R,
% Please edit documentation in R/coord_brick.R, R/draw_key.R, R/geom_brick.R,
% R/geom_brick_col.R, R/geom_brick_point.R, R/resizing_text_grob.R
\docType{data}
\name{CoordBrick}
\alias{CoordBrick}
\alias{CoordBrickFlip}
\alias{draw_key_brick}
\alias{GeomBrick}
\alias{GeomBrickCol}
\alias{GeomStud}
@@ -17,6 +18,8 @@
\usage{
CoordBrickFlip
draw_key_brick(data, params, size)
GeomStud
resizingTextGrob(...)

7
man/generate_instructions.Rd → man/build_instructions.Rd
View File

@@ -1,10 +1,13 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/view_image.R
\name{generate_instructions}
\name{build_instructions}
\alias{build_instructions}
\alias{generate_instructions}
\title{Create instruction manual for 2D image mosaics}
\usage{
generate_instructions(image_list, num_steps = 6)
build_instructions(image_list, num_steps = 6)
generate_instructions(...)
}
\arguments{
\item{image_list}{List output from collect_bricks() or image_to_bricks(). Contains an element \code{Img_lego}.}

7
man/display_set.Rd → man/build_mosaic.Rd
View File

@@ -1,10 +1,13 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/view_image.R
\name{display_set}
\name{build_mosaic}
\alias{build_mosaic}
\alias{display_set}
\title{Display 2D mosaic output as a plot image}
\usage{
display_set(image_list, title = NULL)
build_mosaic(image_list, title = NULL)
display_set(...)
}
\arguments{
\item{image_list}{List output from collect_bricks() or image_to_bricks(). Contains an element \code{Img_lego}.}

14
man/geom_brick_rect.Rd
View File

@@ -1,16 +1,14 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/draw_key.R, R/geom_brick.R
\name{draw_key_brick}
\alias{draw_key_brick}
% Please edit documentation in R/geom_brick.R
\name{geom_brick_rect}
\alias{geom_brick_rect}
\title{ggplot2 Bar Charts as Bricks}
\usage{
draw_key_brick(data, params, size)
geom_brick_rect(mapping = NULL, data = NULL, stat = "identity",
position = "identity", ..., label = "LEGO",
simplified_threshold = 24 * 24, linejoin = "mitre", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE)
position = "identity", ..., label = "brickr",
simplified_threshold = 24 * 24, label_scale = 1,
linejoin = "mitre", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE)
}
\description{
\code{geom_rect}, except bars look like LEGO(R) bricks.