diff --git a/R/bricks-from-tables.R b/R/bricks-from-tables.R index fa0d3c1..bbcdb8e 100644 --- a/R/bricks-from-tables.R +++ b/R/bricks-from-tables.R @@ -16,7 +16,7 @@ #' @export #' bricks_from_table <- function(matrix_table, color_guide = brickr::lego_colors, - piece_table = NULL, + piece_matrix = NULL, .re_level = TRUE, increment_level = 0, max_level = Inf, increment_x = 0, max_x = Inf, @@ -28,6 +28,12 @@ bricks_from_table <- function(matrix_table, color_guide = brickr::lego_colors, names(bricks_raw)[1] <- "Level" names(bricks_raw)[-1] <- paste0("X", seq_along(names(bricks_raw)[-1])) + if(!is.null(piece_matrix)){ + pieces_raw <- piece_matrix + names(pieces_raw)[1] <- "Level" + names(pieces_raw)[-1] <- paste0("X", seq_along(names(pieces_raw)[-1])) + } + #Color mapping color_guide_error_msg <- "Color guide should be a data frame with at least 2 columns: `.value` and `Color`. `Color` should match official LEGO names in the data frame `lego_colors`." @@ -45,7 +51,7 @@ bricks_from_table <- function(matrix_table, color_guide = brickr::lego_colors, # )) # # } - + color_map <- color_guide %>% dplyr::mutate(Color = as.character(Color)) %>% dplyr::left_join(lego_colors, by = "Color") @@ -58,16 +64,21 @@ bricks_from_table <- function(matrix_table, color_guide = brickr::lego_colors, if(.re_level){ bricks_raw <- bricks_raw %>% dplyr::mutate(Level = as.numeric(as.factor(as.character(Level)))) + + if(!is.null(piece_matrix)){ + pieces_raw <- pieces_raw %>% + dplyr::mutate(Level = as.numeric(as.factor(as.character(Level)))) + } } #Clean up increments incr_level <- as.numeric(increment_level)[1] - if(is.na(incr_level)){incr_level<-0} + if(is.na(incr_level)){incr_level <- 0} incr_x <- as.numeric(increment_x)[1] - if(is.na(incr_x)){incr_x<-0} + if(is.na(incr_x)){incr_x <- 0} incr_y <- as.numeric(increment_y)[1] - if(is.na(incr_y)){incr_y<-0} - + if(is.na(incr_y)){incr_y < -0} + brick_set <- bricks_raw %>% dplyr::mutate_all(list(~ifelse(is.na(.), 0, .))) %>% dplyr::group_by(Level) %>% @@ -100,9 +111,33 @@ bricks_from_table <- function(matrix_table, color_guide = brickr::lego_colors, tidyr::drop_na(Lego_color) #Piece tables - if(is.null(piece_table)){ + if(is.null(piece_matrix)){ brick_set <- brick_set %>% dplyr::mutate(piece_type = "B") + } else { + pieces_set <- pieces_raw %>% + dplyr::mutate_all(list(~ifelse(is.na(.), 0, .))) %>% + dplyr::group_by(Level) %>% + dplyr::mutate(y = dplyr::n() - dplyr::row_number() + 1) %>% + dplyr::ungroup() %>% + dplyr::select(Level, y, dplyr::everything()) %>% + tidyr::gather(x, piece_type, 3:ncol(.)) %>% + dplyr::mutate(x = as.numeric(substr(x, 2, 20))) %>% + dplyr::arrange(Level, x, dplyr::desc(y)) %>% + tidyr::drop_na(piece_type) %>% + dplyr::filter(piece_type != "0") %>% + #Exclusions + dplyr::filter(!(Level %in% exclude_level)) %>% + #Increment coordinates + dplyr::mutate(Level = Level + incr_level, + x = x + incr_x, y = y + incr_y) %>% + dplyr::filter(Level >= 1, Level <= max_level, + x >= 1, x <= max_x, + y >= 1, y <= max_y) + + brick_set <- brick_set %>% + dplyr::left_join(pieces_set, by = c("Level", "y", "x")) + } #Return an object from collect_bricks() @@ -184,7 +219,7 @@ bricks_from_excel <- function(excel_table, #Render as brickr output brickr_out <- instructions %>% bricks_from_table(color_guide = colors_user, - piece_table = instructions_p, + piece_matrix = instructions_p, .re_level = TRUE, increment_level = increment_level, max_level = max_level, increment_x = increment_x, max_x = max_x, @@ -209,10 +244,10 @@ bricks_from_excel <- function(excel_table, #' @export #' bricks_from_coords <- function(coord_table, - increment_level = 0, max_level = Inf, - increment_x = 0, max_x = Inf, - increment_y = 0, max_y = Inf, - exclude_color = NULL, exclude_level = NULL){ + increment_level = 0, max_level = Inf, + increment_x = 0, max_x = Inf, + increment_y = 0, max_y = Inf, + exclude_color = NULL, exclude_level = NULL){ #Reformat input table to consistent format bricks_raw <- coord_table @@ -271,6 +306,11 @@ bricks_from_coords <- function(coord_table, dplyr::filter(!all(is.na(Lego_color))) %>% dplyr::ungroup() + if(!("piece_type" %in% names(brick_set))){ + brick_set <- brick_set %>% + dplyr::mutate(piece_type = "B") + } + #Return an object from collect_bricks() return( list(Img_lego = brick_set, diff --git a/R/collect-bricks.R b/R/collect-bricks.R index 5627b45..d21beaa 100644 --- a/R/collect-bricks.R +++ b/R/collect-bricks.R @@ -12,7 +12,7 @@ collect_bricks <- function(image_list, use_bricks = NULL){ #Allowed bricks ---- if(is.null(use_bricks)){ - use_bricks <- c('4x2', '2x2', '4x1', '3x1', '2x1', '1x1') + use_bricks <- c('4x2', '2x2', '4x1', '3x2', '3x1', '2x1', '1x1') } else { #Must contain 1x1... duplicated gets dropped use_bricks <- c(use_bricks, '1x1') @@ -39,8 +39,13 @@ collect_bricks <- function(image_list, use_bricks = NULL){ # Brick looping ---- + multidim_bricks <- c("B", "P") + multidim_bricks <- c(multidim_bricks, tolower(multidim_bricks)) + + # Does any xx*yy space contain all the same color? - img <- (1:nrow(brick_sizes2)) %>% + # Only "brick" shapes will get sizes greater than 1x1 + img_multi <- (1:nrow(brick_sizes2)) %>% purrr::map_dfr(function(aa){ xx <- brick_sizes2$xx[aa] yy <- brick_sizes2$yy[aa] @@ -48,6 +53,7 @@ collect_bricks <- function(image_list, use_bricks = NULL){ offset_y <- brick_sizes2$offset_y[aa] in_list$Img_lego %>% + dplyr::filter(piece_type %in% multidim_bricks) %>% dplyr::select(Level, piece_type, x, y, Lego_name, Lego_color) %>% dplyr::group_by(Level, piece_type, xg = (x + offset_x -1 + Level -1) %/% xx, @@ -61,6 +67,16 @@ collect_bricks <- function(image_list, use_bricks = NULL){ } ) + img_single <- in_list$Img_lego %>% + dplyr::filter(!(piece_type %in% multidim_bricks)) %>% + dplyr::select(Level, piece_type, x, y, Lego_name, Lego_color) %>% + dplyr::mutate(brick_type = paste0("x", 1, "y", 1, "_offx", 0, "_offy", 0)) %>% + dplyr::mutate(brick_name = paste0("brick_", "x", x, "_y", y, "_", Level)) %>% + dplyr::filter(!is.na(Lego_name)) + + #Combine multi- and single- bricks + img <- dplyr::bind_rows(list(img_multi, img_single)) + #Output of all brick types... size * layout bricks <- unique(img$brick_type) @@ -90,7 +106,8 @@ collect_bricks <- function(image_list, use_bricks = NULL){ img2 <- bricks_df %>% # min/max coord for geom_rect() - dplyr::group_by(Level, brick_type, brick_name, Lego_color, Lego_name) %>% + dplyr::group_by(Level, piece_type, brick_type, brick_name, + Lego_color, Lego_name) %>% dplyr::summarise(xmin = min(x)-0.5, xmax = max(x)+0.5, ymin = min(y)-0.5, ymax = max(y)+0.5) %>% dplyr::ungroup() @@ -98,12 +115,13 @@ collect_bricks <- function(image_list, use_bricks = NULL){ # Pieces ---- # This is very brute-force. Probably a much cleaner way to do this pcs <- img2 %>% - dplyr::select(Level, brick_type, brick_name, Lego_name, Lego_color) %>% + dplyr::select(Level, piece_type, brick_type, brick_name, Lego_name, Lego_color) %>% dplyr::distinct() %>% dplyr::mutate(size1 = as.numeric(substr(brick_type, 2, 2)), size2 = as.numeric(substr(brick_type, 4, 4))) %>% dplyr::mutate(Brick_size = ifelse(size1>size2, paste(size1, "x", size2), paste(size2, "x" , size1))) %>% - dplyr::count(Brick_size, Lego_name, Lego_color) + dplyr::mutate(Piece = toupper(substr(piece_type, 1, 1))) %>% + dplyr::count(Brick_size, Piece, Lego_name, Lego_color) in_list[["Img_bricks"]] <- img2 in_list[["ID_bricks"]] <- bricks_df