├── .github ├── .gitignore ├── workflows │ ├── pkgdown.yaml │ └── R-CMD-check.yaml └── R-CMD-check.yaml ├── vignettes ├── .gitignore ├── step01_loading.Rmd ├── step03_refinement.Rmd └── step04_manual_tweak.Rmd ├── data └── werner.rda ├── inst └── extdata │ ├── chongi.png │ ├── corbetti.png │ ├── ocellata.png │ ├── ephippigera.png │ ├── fulgidissima.png │ └── msc │ ├── chongi_white.jpg │ └── corbetti_vector.rds ├── .gitignore ├── man ├── figures │ ├── recolorize_demo.png │ ├── batch_processing.png │ ├── kmeans_vs_recolorize.png │ ├── recolorize_corbetti.png │ └── kmeans_vs_recolorize.jpg.png ├── cimg_to_array.Rd ├── labelCol.Rd ├── plot.recolorizeVector.Rd ├── clean_merge_params.Rd ├── brick_to_array.Rd ├── raster_to_array.Rd ├── classify_recolorize.Rd ├── array_to_cimg.Rd ├── werner.Rd ├── col2col.Rd ├── pixelAssignMatrix.Rd ├── expand_recolorize.Rd ├── medianColors.Rd ├── readImage.Rd ├── array_to_RasterStack.Rd ├── rgb2hsl.Rd ├── recoloredImage.Rd ├── recolorize-package.Rd ├── constructImage.Rd ├── plotImageArray.Rd ├── recolorize_to_patternize.Rd ├── colorClustersKMeans.Rd ├── recolorize_to_png.Rd ├── apply_imager_operation.Rd ├── cielab_coldist.Rd ├── add_image.Rd ├── match_colors.Rd ├── imHeatmap.Rd ├── reorder_colors.Rd ├── adjust_color.Rd ├── plot.recolorize.Rd ├── thresholdRecolor.Rd ├── colorClustersHist.Rd ├── splitByColor.Rd ├── rerun_recolorize.Rd ├── plotColorPalette.Rd ├── wernerColor.Rd ├── blurImage.Rd ├── backgroundIndex.Rd ├── recolorize_adjacency.Rd ├── plotColorClusters.Rd ├── backgroundCondition.Rd ├── assignPixels.Rd ├── colorResiduals.Rd ├── hclust_color.Rd ├── imDist.Rd ├── colorClusters.Rd ├── editLayer.Rd ├── recolorize2.Rd ├── editLayers.Rd ├── mergeLayers.Rd ├── recolorizeVector.Rd └── absorbLayer.Rd ├── CRAN-SUBMISSION ├── _pkgdown.yml ├── revdep ├── .gitignore └── email.yml ├── CRAN-RELEASE ├── R ├── recolorize-package.R ├── recolorImage.R ├── pixelAssignMatrix.R ├── collapse_expand.R ├── brick_to_array.R ├── cimgConversions.R ├── recolorize_to_png.R ├── apply_imager_operation.R ├── plotImageArray.R ├── recolorize_to_patternize.R ├── cielab_coldist.R ├── add_image.R ├── readImage.R ├── constructImage.R ├── medianColors.R ├── raster_array_conversions.R ├── adjust_colors.R ├── rerun_recolorize.R ├── blurImage.R ├── plot_recolorize.R ├── plotColorClusters.R ├── thresholdRecolor.R ├── backgroundIndex.R ├── plotColorPalette.R ├── recolorize2.R ├── assignPixels.R ├── hclust_color.R └── wernerColor.R ├── .Rbuildignore ├── NEWS.md ├── recolorize.Rproj ├── NAMESPACE ├── cran-comments.md ├── DESCRIPTION ├── README.md └── README.Rmd /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /data/werner.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/data/werner.rda -------------------------------------------------------------------------------- /inst/extdata/chongi.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/chongi.png -------------------------------------------------------------------------------- /inst/extdata/corbetti.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/corbetti.png -------------------------------------------------------------------------------- /inst/extdata/ocellata.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/ocellata.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | inst/doc 3 | docs 4 | cran-comments.md 5 | NEWS.md 6 | /doc/ 7 | /Meta/ 8 | .DS_Store -------------------------------------------------------------------------------- /inst/extdata/ephippigera.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/ephippigera.png -------------------------------------------------------------------------------- /inst/extdata/fulgidissima.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/fulgidissima.png -------------------------------------------------------------------------------- /man/figures/recolorize_demo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/man/figures/recolorize_demo.png -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.1.0 2 | Date: 2021-12-06 23:04:36 UTC 3 | SHA: 5da2eabaf8188bd4d7e9e5d43142124ed105f81a 4 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://hiweller.github.io/recolorize/ 2 | template: 3 | bootstrap: 5 4 | bootswatch: flatly 5 | 6 | -------------------------------------------------------------------------------- /inst/extdata/msc/chongi_white.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/msc/chongi_white.jpg -------------------------------------------------------------------------------- /man/figures/batch_processing.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/man/figures/batch_processing.png -------------------------------------------------------------------------------- /inst/extdata/msc/corbetti_vector.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/inst/extdata/msc/corbetti_vector.rds -------------------------------------------------------------------------------- /man/figures/kmeans_vs_recolorize.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/man/figures/kmeans_vs_recolorize.png -------------------------------------------------------------------------------- /man/figures/recolorize_corbetti.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/man/figures/recolorize_corbetti.png -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /man/figures/kmeans_vs_recolorize.jpg.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiweller/recolorize/HEAD/man/figures/kmeans_vs_recolorize.jpg.png -------------------------------------------------------------------------------- /revdep/email.yml: -------------------------------------------------------------------------------- 1 | release_date: ??? 2 | rel_release_date: ??? 3 | my_news_url: ??? 4 | release_version: ??? 5 | release_details: ??? 6 | -------------------------------------------------------------------------------- /CRAN-RELEASE: -------------------------------------------------------------------------------- 1 | This package was submitted to CRAN on 2021-12-04. 2 | Once it is accepted, delete this file and tag the release (commit b2b7d33). 3 | -------------------------------------------------------------------------------- /R/recolorize-package.R: -------------------------------------------------------------------------------- 1 | #' @aliases NULL recolorize-package 2 | #' @keywords internal 3 | "_PACKAGE" 4 | 5 | ## usethis namespace: start 6 | ## usethis namespace: end 7 | NULL 8 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | .travis.yml 2 | html_output/ 3 | LICENSE.md 4 | recolorize.Rproj 5 | ^.*\.Rproj$ 6 | ^\.Rproj\.user$ 7 | ^_pkgdown\.yml$ 8 | ^docs$ 9 | ^pkgdown$ 10 | ^revdep$ 11 | cran-comments.md 12 | ^CRAN-RELEASE$ 13 | ^doc$ 14 | ^Meta$ 15 | ^CRAN-SUBMISSION$ 16 | ^\.github$ 17 | ^README\.Rmd$ 18 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # recolorize 0.2.0 2 | 3 | * Allows TIFF images. 4 | * Minor bug fixes. 5 | * Better handling of NA/NaN values when converting to and from patternize. 6 | * reorder_colors and match_colors functions added. 7 | 8 | # recolorize 0.1.0 9 | 10 | * This is the first release of recolorize. 11 | -------------------------------------------------------------------------------- /man/cimg_to_array.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cimgConversions.R 3 | \name{cimg_to_array} 4 | \alias{cimg_to_array} 5 | \title{Converts from cimg to raster array} 6 | \usage{ 7 | cimg_to_array(x) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{cimg} object.} 11 | } 12 | \value{ 13 | A 3D array. 14 | } 15 | \description{ 16 | What it says it does. 17 | } 18 | -------------------------------------------------------------------------------- /recolorize.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: da9cf4ee-2d56-48f7-b2d0-0dd3dcc2d7ca 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | StripTrailingWhitespace: Yes 18 | LineEndingConversion: Posix 19 | 20 | BuildType: Package 21 | PackageUseDevtools: Yes 22 | PackageInstallArgs: --no-multiarch --with-keep.source 23 | PackageRoxygenize: rd,collate,namespace 24 | -------------------------------------------------------------------------------- /man/labelCol.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recluster.R 3 | \name{labelCol} 4 | \alias{labelCol} 5 | \title{Change colors of dendrogram tips} 6 | \usage{ 7 | labelCol(x, hex_cols, pch = 20, cex = 2) 8 | } 9 | \arguments{ 10 | \item{x}{Leaf of a dendrogram.} 11 | 12 | \item{hex_cols}{Hex color codes for colors to change to.} 13 | 14 | \item{pch}{The type of point to draw.} 15 | 16 | \item{cex}{The size of the point.} 17 | } 18 | \value{ 19 | An \code{hclust} object with colored tips. 20 | } 21 | \description{ 22 | Internal function for \link{recluster} plotting. 23 | } 24 | -------------------------------------------------------------------------------- /man/plot.recolorizeVector.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorizeVector.R 3 | \name{plot.recolorizeVector} 4 | \alias{plot.recolorizeVector} 5 | \title{Plot a \code{recolorizeVector} object} 6 | \usage{ 7 | \method{plot}{recolorizeVector}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Object returned by \link{recolorizeVector}.} 11 | 12 | \item{...}{Further arguments passed to \link[graphics:plot.default]{graphics::plot}.} 13 | } 14 | \value{ 15 | No return value; plots \code{recolorizeVector} as polygons. 16 | } 17 | \description{ 18 | Plots an object generated by \link{recolorizeVector}. 19 | } 20 | -------------------------------------------------------------------------------- /man/clean_merge_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mergeLayers.R 3 | \name{clean_merge_params} 4 | \alias{clean_merge_params} 5 | \title{Clean up parameters passed to mergeLayers} 6 | \usage{ 7 | clean_merge_params(recolorize_obj, merge_list, color_to) 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{Object of \code{recolorize} class.} 11 | 12 | \item{merge_list}{List of layers to merge.} 13 | 14 | \item{color_to}{Argument for coloring new layers.} 15 | } 16 | \value{ 17 | A list of \code{mergeLayers} parameters in a standardized format. 18 | } 19 | \description{ 20 | Internal function for tidiness. 21 | } 22 | -------------------------------------------------------------------------------- /man/brick_to_array.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/brick_to_array.R 3 | \name{brick_to_array} 4 | \alias{brick_to_array} 5 | \title{Convert from a RasterBrick to an array} 6 | \usage{ 7 | brick_to_array(raster_brick) 8 | } 9 | \arguments{ 10 | \item{raster_brick}{An object of RasterBrick class.} 11 | } 12 | \value{ 13 | An image array (probably 1, 3, or 4 channels). 14 | } 15 | \description{ 16 | Converts from a RasterBrick to a numeric array. Useful 17 | in going from patternize to recolorize. 18 | } 19 | \details{ 20 | This function is provided to convert from the RasterBrick objects provided 21 | by the alignment functions in the patternize package, e.g. \code{alignLan}. 22 | } 23 | -------------------------------------------------------------------------------- /man/raster_to_array.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/raster_array_conversions.R 3 | \name{raster_to_array} 4 | \alias{raster_to_array} 5 | \title{Convert from a (small-r) raster object to an RGB array} 6 | \usage{ 7 | raster_to_array(raster_obj, alpha = TRUE) 8 | } 9 | \arguments{ 10 | \item{raster_obj}{A matrix of hex codes as output by \link[grDevices:as.raster]{grDevices::as.raster}.} 11 | 12 | \item{alpha}{Logical. If there is an alpha channel, retain it in the array?} 13 | } 14 | \value{ 15 | A numeric RGB array (0-1 range). 16 | } 17 | \description{ 18 | Recreates the original numeric array from a \code{raster} object created 19 | by \link[grDevices:as.raster]{grDevices::as.raster}. Not to be confused with the \verb{Raster*} classes 20 | used by the \code{raster} package. 21 | } 22 | -------------------------------------------------------------------------------- /man/classify_recolorize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize_adjacency.R 3 | \name{classify_recolorize} 4 | \alias{classify_recolorize} 5 | \title{Convert a \code{recolorize} object to a \code{classify} object} 6 | \usage{ 7 | classify_recolorize(recolorize_obj, imgname = "") 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{A \code{recolorize} object.} 11 | 12 | \item{imgname}{Name of the image (a string).} 13 | } 14 | \value{ 15 | A \link[pavo:classify]{pavo::classify} object. The background patch will always 16 | be the first color (patch 1), and will be white by default. 17 | } 18 | \description{ 19 | Converts a \link{recolorize} object to a \link[pavo:classify]{pavo::classify} object for 20 | use in pavo. 21 | } 22 | \details{ 23 | This is mostly for internal use, and hasn't been tested much. 24 | } 25 | -------------------------------------------------------------------------------- /man/array_to_cimg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cimgConversions.R 3 | \name{array_to_cimg} 4 | \alias{array_to_cimg} 5 | \title{Converts from a raster array to a cimg object} 6 | \usage{ 7 | array_to_cimg(x, flatten_alpha = TRUE, bg = "white", rm_alpha = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{An image array, i.e. as read in by readPNG.} 11 | 12 | \item{flatten_alpha}{Logical. Flatten the alpha channel?} 13 | 14 | \item{bg}{Passed to \code{\link[imager:flatten.alpha]{imager::flatten.alpha()}}. Pixel color for 15 | previously transparent pixels.} 16 | 17 | \item{rm_alpha}{Logical. Remove the alpha channel? 18 | Note this will "reveal" whatever is hidden behind 19 | the transparent pixels, rather than turn them white.} 20 | } 21 | \value{ 22 | A \code{cimg} object. 23 | } 24 | \description{ 25 | What it says it does. 26 | } 27 | -------------------------------------------------------------------------------- /man/werner.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wernerColor.R 3 | \docType{data} 4 | \name{werner} 5 | \alias{werner} 6 | \title{Werner's nomenclature of colors} 7 | \format{ 8 | A data frame with 110 rows and 13 variables: 9 | \describe{ 10 | \item{index}{The color index.} 11 | \item{family}{The broad color category (white, red, etc).} 12 | \item{name}{The original color name.} 13 | \item{hex}{Color hex code.} 14 | } 15 | } 16 | \source{ 17 | \url{https://www.c82.net/werner/#colors} 18 | } 19 | \usage{ 20 | werner 21 | } 22 | \description{ 23 | A table of the 110 colors described in "Werner's Nomenclature of Colors", the 24 | 1821 color reference by Patrick Syme (building on work by Abraham Gottlob 25 | Werner), notably used by Charles Darwin. Colors represent the average pixel 26 | color of each scanned swatch. 27 | } 28 | \keyword{datasets} 29 | -------------------------------------------------------------------------------- /man/col2col.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorClusters.R 3 | \name{col2col} 4 | \alias{col2col} 5 | \title{Modified convertColor} 6 | \usage{ 7 | col2col( 8 | pixel_matrix, 9 | from = c("sRGB", "Lab", "Luv", "HSV"), 10 | to = c("sRGB", "Lab", "Luv", "HSV"), 11 | ref_white = "D65" 12 | ) 13 | } 14 | \arguments{ 15 | \item{pixel_matrix}{A matrix of pixel colors, rows are pixels and columns 16 | are channels.} 17 | 18 | \item{from}{Color space to convert from.} 19 | 20 | \item{to}{Color space to convert to.} 21 | 22 | \item{ref_white}{Reference white.} 23 | } 24 | \value{ 25 | A pixel matrix in the specified \code{to} color space. 26 | } 27 | \description{ 28 | Just like \link[grDevices:convertColor]{grDevices::convertColor}, but with HSV as an option. 29 | } 30 | \details{ 31 | As my mother used to say: good enough for government work. 32 | } 33 | -------------------------------------------------------------------------------- /man/pixelAssignMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pixelAssignMatrix.R 3 | \name{pixelAssignMatrix} 4 | \alias{pixelAssignMatrix} 5 | \title{Make pixel assignment matrix for recoloring} 6 | \usage{ 7 | pixelAssignMatrix(bg_indexed, color_clusters) 8 | } 9 | \arguments{ 10 | \item{bg_indexed}{An object returned by \code{\link[=backgroundIndex]{backgroundIndex()}}.} 11 | 12 | \item{color_clusters}{An object returned by \code{\link[=colorClusters]{colorClusters()}}.} 13 | } 14 | \value{ 15 | A matrix of pixel color assignments (\code{pixel_assignments}) 16 | and a corresponding dataframe of color centers (\code{centers}). 17 | } 18 | \description{ 19 | Internal function. Generates a sort of 'paint-by-numbers' matrix, where each 20 | cell is the index of the color in the color centers matrix to which that 21 | pixel is assigned. An index of 0 indicates a background pixel. 22 | } 23 | -------------------------------------------------------------------------------- /man/expand_recolorize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/collapse_expand.R 3 | \name{expand_recolorize} 4 | \alias{expand_recolorize} 5 | \title{Expand aspects of a recolorize object for other functions} 6 | \usage{ 7 | expand_recolorize( 8 | recolorize_obj, 9 | original_img = FALSE, 10 | recolored_img = FALSE, 11 | sizes = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{recolorize_obj}{A \code{recolorize} object.} 16 | 17 | \item{original_img}{Logical. Return original image as numeric array?} 18 | 19 | \item{recolored_img}{Logical. Return recolored image as numeric array?} 20 | 21 | \item{sizes}{Logical. Return cluster sizes (as number of pixels)?} 22 | } 23 | \value{ 24 | A \code{recolorize} object with the indicated additional elements, 25 | as well as the original elements. 26 | } 27 | \description{ 28 | Expand aspects of a recolorize object for other functions 29 | } 30 | -------------------------------------------------------------------------------- /man/medianColors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/medianColors.R 3 | \name{medianColors} 4 | \alias{medianColors} 5 | \title{Change color centers to median color of all pixels assigned to it} 6 | \usage{ 7 | medianColors(recolorize_obj, plotting = TRUE) 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{A \code{recolorize} class object.} 11 | 12 | \item{plotting}{Logical. Plot results?} 13 | } 14 | \value{ 15 | A \code{recolorize} object, with median colors instead of average colors 16 | in the \code{centers} attribute. 17 | } 18 | \description{ 19 | By default, recolorize sets the centers of each color patch to the average 20 | (mean) color of all pixels assigned to it. This can sometimes result in colors 21 | that look washed out, especially in cases where a region is very shiny (e.g. 22 | black with white reflective highlights will average to grey). In these cases, 23 | switching to median colors may be either more accurate or more visually 24 | pleasing. 25 | } 26 | -------------------------------------------------------------------------------- /man/readImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readImage.R 3 | \name{readImage} 4 | \alias{readImage} 5 | \title{Read in an image as a 3D array} 6 | \usage{ 7 | readImage(img_path, resize = NULL, rotate = NULL) 8 | } 9 | \arguments{ 10 | \item{img_path}{Path to the image (a string).} 11 | 12 | \item{resize}{Fraction by which to reduce image size. Important for speed.} 13 | 14 | \item{rotate}{Number of degrees to rotate the image.} 15 | } 16 | \value{ 17 | A 3D RGB array (pixel rows x pixel columns x color channels). RGB channels 18 | are all scaled 0-1, not 0-255. 19 | } 20 | \description{ 21 | Reads in and processes an image as a 3D array. Extremely simple wrapper for 22 | \code{\link[imager:load.image]{imager::load.image()}}, but it strips the depth channel (resulting 23 | in a 3D, not 4D, array). This will probably change. 24 | } 25 | \examples{ 26 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 27 | img <- readImage(corbetti) 28 | plotImageArray(img) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/array_to_RasterStack.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/raster_array_conversions.R 3 | \name{array_to_RasterStack} 4 | \alias{array_to_RasterStack} 5 | \title{Convert from an array to a raster stack} 6 | \usage{ 7 | array_to_RasterStack( 8 | img_array, 9 | type = c("stack", "brick"), 10 | alpha_mask = TRUE, 11 | return_alpha = FALSE 12 | ) 13 | } 14 | \arguments{ 15 | \item{img_array}{An RGB array.} 16 | 17 | \item{type}{Type of Raster* object to return. One of either "stack" 18 | (\link[raster:stack]{raster::stack}) or "brick" (\link[raster:brick]{raster::brick}).} 19 | 20 | \item{alpha_mask}{Logical. Use the alpha channel as a background mask?} 21 | 22 | \item{return_alpha}{Logical. Return the alpha channel as a layer?} 23 | } 24 | \value{ 25 | A Raster* object, either \code{RasterStack} or \code{RasterBrick} depending 26 | on the \code{type} argument. 27 | } 28 | \description{ 29 | Convert from an image array to a raster stack, optionally using the alpha 30 | channel as a mask. 31 | } 32 | -------------------------------------------------------------------------------- /man/rgb2hsl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize_adjacency.R 3 | \name{rgb2hsl} 4 | \alias{rgb2hsl} 5 | \title{Convert RGB colors to HSL} 6 | \usage{ 7 | rgb2hsl(rgb_matrix, radians = TRUE, pavo_hsl = TRUE) 8 | } 9 | \arguments{ 10 | \item{rgb_matrix}{RGB colors in an nx3 matrix (rows = colors, 11 | columns = channels).} 12 | 13 | \item{radians}{Logical. Return HSL colors in units of radians 14 | (\code{TRUE}) or degrees (\code{FALSE})?} 15 | 16 | \item{pavo_hsl}{Logical. Return HSL matrix in a format that 17 | can be passed directly to \link[pavo:adjacent]{pavo::adjacent} as the \code{hsl} parameter?} 18 | } 19 | \value{ 20 | A dataframe with \code{patch}, \code{hue}, \code{sat}, and \code{lum} columns 21 | and one row per color (if \code{pavo_hsl = TRUE}) or a matrix of the HSL 22 | coordinates (if \code{pavo_hsl = FALSE}). 23 | } 24 | \description{ 25 | Convert RGB colors (0-1 range) to HSL (hue-saturation-luminance) 26 | space. Used for passing RGB colors to \link[pavo:adjacent]{pavo::adjacent}. 27 | } 28 | -------------------------------------------------------------------------------- /man/recoloredImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorImage.R 3 | \name{recoloredImage} 4 | \alias{recoloredImage} 5 | \title{Get recolored image from a recolorize object} 6 | \usage{ 7 | recoloredImage(recolorize_obj, type = c("array", "raster")) 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{An object of class \code{recolorize}. Must include 11 | a pixel assignment matrix and matrix of color centers.} 12 | 13 | \item{type}{Type of image to return. One of either "array" or "raster". 14 | Arrays are numeric RGB arrays (larger, but easier to do operations on), 15 | rasters are matrices of hex codes (smaller, only really good for plotting).} 16 | } 17 | \value{ 18 | A numeric image array (if \code{type = array}) or a matrix of hex codes ( 19 | if \code{type = raster}). 20 | } 21 | \description{ 22 | \code{recolorize} objects use a numeric color map and a matrix of 23 | color centers to make recolored images, since this is a lighter weight 24 | and more flexible format. This function generates a colored image 25 | from those values for plotting. 26 | } 27 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(plot,recolorize) 4 | S3method(plot,recolorizeVector) 5 | export(absorbLayer) 6 | export(add_image) 7 | export(adjust_color) 8 | export(assignPixels) 9 | export(backgroundCondition) 10 | export(backgroundIndex) 11 | export(blurImage) 12 | export(brick_to_array) 13 | export(classify_recolorize) 14 | export(colorClusters) 15 | export(colorResiduals) 16 | export(constructImage) 17 | export(editLayer) 18 | export(editLayers) 19 | export(hclust_color) 20 | export(imDist) 21 | export(imHeatmap) 22 | export(imposeColors) 23 | export(match_colors) 24 | export(medianColors) 25 | export(mergeLayers) 26 | export(plotColorClusters) 27 | export(plotColorPalette) 28 | export(plotImageArray) 29 | export(raster_to_array) 30 | export(readImage) 31 | export(recluster) 32 | export(recoloredImage) 33 | export(recolorize) 34 | export(recolorize2) 35 | export(recolorizeVector) 36 | export(recolorize_adjacency) 37 | export(recolorize_to_patternize) 38 | export(recolorize_to_png) 39 | export(reorder_colors) 40 | export(rerun_recolorize) 41 | export(splitByColor) 42 | export(thresholdRecolor) 43 | export(wernerColor) 44 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | tags: ['*'] 7 | 8 | name: pkgdown 9 | 10 | jobs: 11 | pkgdown: 12 | runs-on: ubuntu-latest 13 | env: 14 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 15 | steps: 16 | - uses: actions/checkout@v4 17 | 18 | - uses: r-lib/actions/setup-pandoc@v2 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: pkgdown 27 | needs: website 28 | 29 | - name: Deploy package 30 | run: | 31 | git config --local user.name "$GITHUB_ACTOR" 32 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 33 | # Install the package first 34 | Rscript -e 'install.packages(".", repos = NULL, type = "source")' 35 | # Then run pkgdown 36 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 37 | -------------------------------------------------------------------------------- /R/recolorImage.R: -------------------------------------------------------------------------------- 1 | #' Get recolored image from a recolorize object 2 | #' 3 | #' `recolorize` objects use a numeric color map and a matrix of 4 | #' color centers to make recolored images, since this is a lighter weight 5 | #' and more flexible format. This function generates a colored image 6 | #' from those values for plotting. 7 | #' 8 | #' @param recolorize_obj An object of class `recolorize`. Must include 9 | #' a pixel assignment matrix and matrix of color centers. 10 | #' @param type Type of image to return. One of either "array" or "raster". 11 | #' Arrays are numeric RGB arrays (larger, but easier to do operations on), 12 | #' rasters are matrices of hex codes (smaller, only really good for plotting). 13 | #' 14 | #' @return A numeric image array (if `type = array`) or a matrix of hex codes ( 15 | #' if `type = raster`). 16 | #' 17 | #' 18 | #' @export 19 | recoloredImage <- function(recolorize_obj, 20 | type = c("array", "raster")) { 21 | 22 | type <- match.arg(type) 23 | img <- constructImage(recolorize_obj$pixel_assignments, 24 | recolorize_obj$centers) 25 | if(type == "raster") { 26 | img <- grDevices::as.raster(img) 27 | } 28 | 29 | return(img) 30 | 31 | } 32 | -------------------------------------------------------------------------------- /R/pixelAssignMatrix.R: -------------------------------------------------------------------------------- 1 | #' Make pixel assignment matrix for recoloring 2 | #' 3 | #' Internal function. Generates a sort of 'paint-by-numbers' matrix, where each 4 | #' cell is the index of the color in the color centers matrix to which that 5 | #' pixel is assigned. An index of 0 indicates a background pixel. 6 | #' 7 | #' @param bg_indexed An object returned by [backgroundIndex()]. 8 | #' @param color_clusters An object returned by [colorClusters()]. 9 | #' 10 | #' @return A matrix of pixel color assignments (`pixel_assignments`) 11 | #' and a corresponding dataframe of color centers (`centers`). 12 | pixelAssignMatrix <- function(bg_indexed, color_clusters) { 13 | 14 | # make a vector of 0's, one per image pixel 15 | pix_assign <- rep(0, nrow(bg_indexed$flattened_img)) 16 | 17 | # swap in the color assignments for the pixels 18 | if (length(bg_indexed$idx_flat) == 0) { 19 | pix_assign <- color_clusters$pixel_assignments 20 | } else { 21 | pix_assign[-bg_indexed$idx_flat] <- color_clusters$pixel_assignments 22 | } 23 | 24 | # and reshape: 25 | dim(pix_assign) <- bg_indexed$img_dims[1:2] 26 | 27 | # return it! 28 | return(list(pixel_assignments = pix_assign, 29 | centers = color_clusters$centers)) 30 | 31 | } 32 | 33 | -------------------------------------------------------------------------------- /R/collapse_expand.R: -------------------------------------------------------------------------------- 1 | #' Expand aspects of a recolorize object for other functions 2 | #' 3 | #' @param recolorize_obj A `recolorize` object. 4 | #' @param original_img Logical. Return original image as numeric array? 5 | #' @param recolored_img Logical. Return recolored image as numeric array? 6 | #' @param sizes Logical. Return cluster sizes (as number of pixels)? 7 | #' 8 | #' @return A `recolorize` object with the indicated additional elements, 9 | #' as well as the original elements. 10 | expand_recolorize <- function(recolorize_obj, 11 | original_img = FALSE, 12 | recolored_img = FALSE, 13 | sizes = FALSE) { 14 | 15 | rc <- recolorize_obj 16 | 17 | if (original_img) { 18 | rc$original_img <- raster_to_array(recolorize_obj$original_img) 19 | } 20 | 21 | if (recolored_img) { 22 | rc$recolored_img <- constructImage(recolorize_obj$pixel_assignments, 23 | recolorize_obj$centers) 24 | } 25 | 26 | if (sizes) { 27 | sizes <- table(recolorize_obj$pixel_assignments) 28 | sizes <- sizes[-which(names(sizes) == 0)] 29 | rc$sizes <- sizes[order(as.numeric(names(sizes)))] 30 | } 31 | 32 | return(rc) 33 | 34 | } 35 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | 3 | * local macOS 15.3.1 install, R version 4.4.3 (2025-02-28) 4 | * GitHub Actions (macos-latest release, windows-latest release, ubuntu-latest devel, release, and oldrel-1) 5 | * win-builder (release and oldrelease) 6 | 7 | 8 | ## R CMD check results 9 | 10 | * local check: 0 errors | 0 warnings | 1 note 11 | * GitHub Actions: 0 errors | 0 warnings | 0 notes 12 | * win-builder: 0 errors | 0 warnings | 0 notes 13 | 14 | - checking installed package size ... NOTE 15 | installed size is 15.3Mb 16 | sub-directories of 1Mb or more: 17 | doc 2.9Mb 18 | extdata 1.1Mb 19 | help 11.2Mb 20 | 21 | This is an image-processing package so the vignettes include several images, hence the larger directory size. 22 | 23 | ## Downstream dependencies 24 | 25 | There are currently no downstream dependencies for this package. 26 | 27 | # Examples 28 | 29 | Four examples are not run with R CMD check (\donttest): recolorizeVector, absorbLayer, recolorize_to_patternize, and recolorize_to_png. The first three are not run because they take longer than 10 seconds to evaluate (they involve relatively complex image processing and/or conversion). recolorize_to_png is not run because it writes (and deletes) a file to the current working directory. 30 | -------------------------------------------------------------------------------- /man/recolorize-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize-package.R 3 | \docType{package} 4 | \name{recolorize-package} 5 | \alias{recolorize-package} 6 | \title{recolorize: Color-Based Image Segmentation} 7 | \description{ 8 | Automatic, semi-automatic, and manual functions for generating color maps from images. The idea is to simplify the colors of an image according to a metric that is useful for the user, using deterministic methods whenever possible. Many images will be clustered well using the out-of-the-box functions, but the package also includes a toolbox of functions for making manual adjustments (layer merging/isolation, blurring, fitting to provided color clusters or those from another image, etc). Also includes export methods for other color/pattern analysis packages (pavo, patternize, colordistance). 9 | } 10 | \seealso{ 11 | Useful links: 12 | \itemize{ 13 | \item \url{https://hiweller.github.io/recolorize/} 14 | \item \url{https://github.com/hiweller/recolorize} 15 | \item Report bugs at \url{https://github.com/hiweller/recolorize/issues} 16 | } 17 | 18 | } 19 | \author{ 20 | \strong{Maintainer}: Hannah Weller \email{hannahiweller@gmail.com} (\href{https://orcid.org/0000-0002-5252-4282}{ORCID}) 21 | 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /R/brick_to_array.R: -------------------------------------------------------------------------------- 1 | #' Convert from a RasterBrick to an array 2 | #' 3 | #' Converts from a RasterBrick to a numeric array. Useful 4 | #' in going from patternize to recolorize. 5 | #' 6 | #' @param raster_brick An object of RasterBrick class. 7 | #' 8 | #' @return An image array (probably 1, 3, or 4 channels). 9 | #' 10 | #' @details 11 | #' This function is provided to convert from the RasterBrick objects provided 12 | #' by the alignment functions in the patternize package, e.g. `alignLan`. 13 | #' 14 | #' @export 15 | brick_to_array <- function(raster_brick) { 16 | 17 | # shorter object name 18 | r <- raster_brick 19 | 20 | # get non-background pixels (> 0) and set them to have alpha = 1 21 | r[is.na(r)] <- 0 22 | r_alpha <- r$layer.1 > 0 | r$layer.2 > 0 | r$layer.3 > 0 23 | 24 | # adjust negative values 25 | r[r < 0] <- 0 26 | 27 | # add alpha layer 28 | # divide r by 255 so it's in a 0-1 range 29 | # idk what's going on but here's a weird failsafe: 30 | r_range <- max(raster::maxValue(r)) - min(raster::minValue(r)) 31 | if (r_range > 255) { 32 | r2 <- raster::addLayer(r / r_range, r_alpha) 33 | } else { 34 | r2 <- raster::addLayer(r / 255, r_alpha) 35 | } 36 | 37 | # convert to an array 38 | r3 <- raster::as.array(r2) 39 | 40 | # and return 41 | return(r3) 42 | 43 | } 44 | -------------------------------------------------------------------------------- /man/constructImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/constructImage.R 3 | \name{constructImage} 4 | \alias{constructImage} 5 | \title{Generate an image from pixel assignments and color matrix} 6 | \usage{ 7 | constructImage(pixel_assignments, centers, background_color = "white") 8 | } 9 | \arguments{ 10 | \item{pixel_assignments}{A matrix of index values for each pixel which 11 | corresponds to \code{centers} (e.g. a \code{1} indicates that pixel is the 12 | color of the first row of \code{centers}). Pixels with an index value of 0 13 | are considered background.} 14 | 15 | \item{centers}{An n x 3 matrix of color centers where rows are colors 16 | and columns are R, G, and B channels.} 17 | 18 | \item{background_color}{A numeric RGB triplet, a hex code, or a named 19 | R color for the background. Will be masked by alpha channel (and appear 20 | white in the plot window), but will be revealed if the alpha 21 | channel is removed. If the alpha channel is a background mask, 22 | this is the 'baked in' background color.} 23 | } 24 | \value{ 25 | An image (raster) array of the recolored image, 26 | with four channels (R, G, B, and alpha). 27 | } 28 | \description{ 29 | Combines a matrix of pixel assignments and a corresponding 30 | matrix of colors to make a recolored RGB image. 31 | } 32 | -------------------------------------------------------------------------------- /R/cimgConversions.R: -------------------------------------------------------------------------------- 1 | #' Converts from cimg to raster array 2 | #' 3 | #' What it says it does. 4 | #' 5 | #' @param x A `cimg` object. 6 | #' 7 | #' @return A 3D array. 8 | cimg_to_array <- function(x) { 9 | img <- as.numeric(x) 10 | dim(img) <- dim(x)[c(1, 2, 4)] 11 | if (dim(img)[3] == 1) { 12 | dim(img) <- dim(img)[1:2] 13 | } 14 | return(img) 15 | } 16 | 17 | #' Converts from a raster array to a cimg object 18 | #' 19 | #' What it says it does. 20 | #' 21 | #' @param x An image array, i.e. as read in by readPNG. 22 | #' @param flatten_alpha Logical. Flatten the alpha channel? 23 | #' @param bg Passed to [imager::flatten.alpha()]. Pixel color for 24 | #' previously transparent pixels. 25 | #' @param rm_alpha Logical. Remove the alpha channel? 26 | #' Note this will "reveal" whatever is hidden behind 27 | #' the transparent pixels, rather than turn them white. 28 | #' 29 | #' @return A `cimg` object. 30 | array_to_cimg <- function(x, 31 | flatten_alpha = TRUE, 32 | bg = "white", 33 | rm_alpha = TRUE) { 34 | 35 | dim(x) <- c(dim(x)[1:2], 1, dim(x)[3]) 36 | class(x) <- "cimg" 37 | 38 | if (flatten_alpha) { 39 | x <- imager::flatten.alpha(x, "white") 40 | } 41 | 42 | if (rm_alpha) { 43 | x <- imager::rm.alpha(x) 44 | } 45 | 46 | return(x) 47 | 48 | } 49 | -------------------------------------------------------------------------------- /R/recolorize_to_png.R: -------------------------------------------------------------------------------- 1 | #' Save a recolored image as a PNG 2 | #' 3 | #' Saves a recolored image from a recolorize object to a PNG. This is 4 | #' done by calling [recoloredImage] and [png::writePNG]. 5 | #' 6 | #' @param recolorize_obj A recolorize object. 7 | #' @param filename Filename for saving the PNG. 8 | #' 9 | #' @return No return value; saves a PNG file to the specified location. 10 | #' 11 | #' @details This function saves a png with the same dimensions (in pixels) as the 12 | #' image that was originally provided to recolorize (meaning if you resized your original 13 | #' image, the resulting PNG will also be smaller). Anything more complicated can be 14 | #' created with custom scripts: for example, you could create a vector image using 15 | #' [recolorizeVector], and then save this as a PNG of any resolution/size. 16 | #' 17 | #' @examples 18 | #' \donttest{ 19 | #' img <- system.file("extdata/corbetti.png", package = "recolorize") 20 | #' rc <- recolorize2(img, cutoff = 45) 21 | #' 22 | #' # save a PNG: 23 | #' recolorize_to_png(rc, "corbetti_recolored.png") 24 | #' 25 | #' # remove the PNG (so this example doesn't spam your working directory) 26 | #' file.remove("corbetti_recolored.png") 27 | #' } 28 | #' 29 | #' @export 30 | recolorize_to_png <- function(recolorize_obj, filename = "") { 31 | img <- recoloredImage(recolorize_obj) 32 | png::writePNG(img, target = filename) 33 | } 34 | -------------------------------------------------------------------------------- /man/plotImageArray.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotImageArray.R 3 | \name{plotImageArray} 4 | \alias{plotImageArray} 5 | \title{Plot a 3D array as an RGB image} 6 | \usage{ 7 | plotImageArray(rgb_array, main = "", ...) 8 | } 9 | \arguments{ 10 | \item{rgb_array}{A 3D array of RGB values. Preferably output from 11 | \code{\link[png:readPNG]{png::readPNG()}}, \code{\link[jpeg:readJPEG]{jpeg::readJPEG()}}, 12 | \link{recoloredImage}, \link{constructImage}, or \link{raster_to_array}.} 13 | 14 | \item{main}{Optional title for plot.} 15 | 16 | \item{...}{Parameters passed to \link[graphics:plot.default]{graphics::plot}.} 17 | } 18 | \value{ 19 | No return value; plots image. 20 | } 21 | \description{ 22 | Does what it says on the tin. An extremely simple wrapper for 23 | \code{\link[graphics:rasterImage]{graphics::rasterImage()}}, but maintains aspect ratio, removes 24 | axes, and reduces margins for cleaner plotting. 25 | } 26 | \examples{ 27 | # make a 100x100 image of random colors 28 | random_colors <- array(runif(100 * 100 * 3), 29 | dim = c(100, 100, 3)) 30 | recolorize::plotImageArray(random_colors) 31 | 32 | # we can also plot...a real image 33 | corbetti <- system.file("extdata/corbetti.png", 34 | package = "recolorize") 35 | img <- png::readPNG(corbetti) 36 | plotImageArray(img) 37 | } 38 | -------------------------------------------------------------------------------- /man/recolorize_to_patternize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize_to_patternize.R 3 | \name{recolorize_to_patternize} 4 | \alias{recolorize_to_patternize} 5 | \title{Convert a recolorize object to a raster object} 6 | \usage{ 7 | recolorize_to_patternize(recolorize_obj, return_background = FALSE) 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{A \code{recolorize} object.} 11 | 12 | \item{return_background}{Logical.} 13 | } 14 | \value{ 15 | A list of RasterLayer objects, one per color class. 16 | } 17 | \description{ 18 | Convert from a \code{recolorize} object to a list of RasterLayer objects, the 19 | format required by the \code{patternize} package. Note that most of the downstream 20 | \code{patternize} functions that require lists of RasterLayer objects mostly 21 | require lists of these lists, so you will probably need to use this function 22 | on a list of \code{recolorize} objects. 23 | } 24 | \details{ 25 | Note that this function does not retain the colors of the layers -- 26 | you won't be able to convert back to a recolorize object from this object. 27 | } 28 | \examples{ 29 | 30 | \donttest{ 31 | # fit recolorize object: 32 | img <- system.file("extdata/ephippigera.png", package = "recolorize") 33 | rc <- recolorize2(img) 34 | 35 | # takes ~10 sec to run: 36 | # convert to a raster list: 37 | as_raster_list <- recolorize_to_patternize(rc) 38 | } 39 | 40 | } 41 | -------------------------------------------------------------------------------- /man/colorClustersKMeans.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorClusters.R 3 | \name{colorClustersKMeans} 4 | \alias{colorClustersKMeans} 5 | \title{Cluster pixel colors using K-means clustering} 6 | \usage{ 7 | colorClustersKMeans( 8 | pixel_matrix, 9 | n = 10, 10 | color_space = "Lab", 11 | ref_white = "D65" 12 | ) 13 | } 14 | \arguments{ 15 | \item{pixel_matrix}{2D matrix of pixels to classify (rows = pixels, columns = 16 | channels).} 17 | 18 | \item{n}{Number of clusters to fit.} 19 | 20 | \item{color_space}{Color space in which to cluster colors, passed to 21 | \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", "Luv", or 22 | "XYZ". Default is "Lab", a perceptually uniform (for humans) color space.} 23 | 24 | \item{ref_white}{Reference white for converting to different color spaces. 25 | D65 (the default) corresponds to standard daylight.} 26 | } 27 | \value{ 28 | A list with the following elements: 29 | \enumerate{ 30 | \item \code{pixel_assignments}: A vector of color center assignments for each pixel. 31 | \item \code{centers}: A matrix of color centers. 32 | \item \code{sizes}: The number of pixels assigned to each cluster. 33 | } 34 | } 35 | \description{ 36 | Clusters pixel colors using \code{\link[stats:kmeans]{stats::kmeans()}}. 37 | } 38 | \details{ 39 | Called by \code{\link[=colorClusters]{colorClusters()}}. See that documentation for 40 | examples. 41 | } 42 | -------------------------------------------------------------------------------- /R/apply_imager_operation.R: -------------------------------------------------------------------------------- 1 | #' Apply imager operations to layers of an image 2 | #' 3 | #' Internal wrapper function for applying any of several 4 | #' `imager` morphological operations for cleaning pixsets. 5 | #' 6 | #' @param pixset An object of class `pixset`. Usually a layer from 7 | #' [splitByColor()] that has been converted to a `pixset` 8 | #' object. 9 | #' @param imager_function The name of an imager morphological operation that can 10 | #' be performed on a pixset, passed as a string. See details. 11 | #' @param ... Further arguments passed to the imager function being used. 12 | #' 13 | #' @details 14 | #' Current imager operations are: 15 | #' \itemize{ 16 | #' \item [imager::grow()]: Grow a pixset 17 | #' \item [imager::shrink()]: Shrink a pixset 18 | #' \item [imager::fill()]: Remove holes in an pixset. Accomplished by 19 | #' growing and then shrinking a pixset. 20 | #' \item [imager::clean()]: Remove small isolated elements (speckle). 21 | #' Accomplished by shrinking and then growing a pixset. 22 | #' } 23 | #' 24 | #' @return The resulting pixset after applying the specified morphological 25 | #' operation. 26 | #' 27 | apply_imager_operation <- function(pixset, imager_function, ...) { 28 | switch(imager_function, 29 | fill = imager::fill(pixset, ...), 30 | clean = imager::clean(pixset, ...), 31 | grow = imager::grow(pixset, ...), 32 | shrink = imager::shrink(pixset, ...)) 33 | } 34 | -------------------------------------------------------------------------------- /man/recolorize_to_png.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize_to_png.R 3 | \name{recolorize_to_png} 4 | \alias{recolorize_to_png} 5 | \title{Save a recolored image as a PNG} 6 | \usage{ 7 | recolorize_to_png(recolorize_obj, filename = "") 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{A recolorize object.} 11 | 12 | \item{filename}{Filename for saving the PNG.} 13 | } 14 | \value{ 15 | No return value; saves a PNG file to the specified location. 16 | } 17 | \description{ 18 | Saves a recolored image from a recolorize object to a PNG. This is 19 | done by calling \link{recoloredImage} and \link[png:writePNG]{png::writePNG}. 20 | } 21 | \details{ 22 | This function saves a png with the same dimensions (in pixels) as the 23 | image that was originally provided to recolorize (meaning if you resized your original 24 | image, the resulting PNG will also be smaller). Anything more complicated can be 25 | created with custom scripts: for example, you could create a vector image using 26 | \link{recolorizeVector}, and then save this as a PNG of any resolution/size. 27 | } 28 | \examples{ 29 | \donttest{ 30 | img <- system.file("extdata/corbetti.png", package = "recolorize") 31 | rc <- recolorize2(img, cutoff = 45) 32 | 33 | # save a PNG: 34 | recolorize_to_png(rc, "corbetti_recolored.png") 35 | 36 | # remove the PNG (so this example doesn't spam your working directory) 37 | file.remove("corbetti_recolored.png") 38 | } 39 | 40 | } 41 | -------------------------------------------------------------------------------- /man/apply_imager_operation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/apply_imager_operation.R 3 | \name{apply_imager_operation} 4 | \alias{apply_imager_operation} 5 | \title{Apply imager operations to layers of an image} 6 | \usage{ 7 | apply_imager_operation(pixset, imager_function, ...) 8 | } 9 | \arguments{ 10 | \item{pixset}{An object of class \code{pixset}. Usually a layer from 11 | \code{\link[=splitByColor]{splitByColor()}} that has been converted to a \code{pixset} 12 | object.} 13 | 14 | \item{imager_function}{The name of an imager morphological operation that can 15 | be performed on a pixset, passed as a string. See details.} 16 | 17 | \item{...}{Further arguments passed to the imager function being used.} 18 | } 19 | \value{ 20 | The resulting pixset after applying the specified morphological 21 | operation. 22 | } 23 | \description{ 24 | Internal wrapper function for applying any of several 25 | \code{imager} morphological operations for cleaning pixsets. 26 | } 27 | \details{ 28 | Current imager operations are: 29 | \itemize{ 30 | \item \code{\link[imager:grow]{imager::grow()}}: Grow a pixset 31 | \item \code{\link[imager:grow]{imager::shrink()}}: Shrink a pixset 32 | \item \code{\link[imager:clean]{imager::fill()}}: Remove holes in an pixset. Accomplished by 33 | growing and then shrinking a pixset. 34 | \item \code{\link[imager:clean]{imager::clean()}}: Remove small isolated elements (speckle). 35 | Accomplished by shrinking and then growing a pixset. 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /.github/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macOS-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v2 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: any::rcmdcheck 45 | needs: check 46 | 47 | - uses: r-lib/actions/check-r-package@v2 48 | with: 49 | upload-snapshots: true 50 | -------------------------------------------------------------------------------- /man/cielab_coldist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cielab_coldist.R 3 | \name{cielab_coldist} 4 | \alias{cielab_coldist} 5 | \title{Generate a 'coldist' object for CIE Lab colors} 6 | \usage{ 7 | cielab_coldist(rgbcols) 8 | } 9 | \arguments{ 10 | \item{rgbcols}{An nx3 matrix of RGB colors (rows are colors and 11 | columns are R, G, and B channels).} 12 | } 13 | \value{ 14 | A \link[pavo:coldist]{pavo::coldist} object with four columns: the patches 15 | being contrasted (columns 1-2), the chromatic contrast (\code{dS}), 16 | and the achromatic contrast (\code{dL}), all in units of Euclidean 17 | distance in CIE Lab space. 18 | } 19 | \description{ 20 | A stopgap function for generating a \link[pavo:coldist]{pavo::coldist} object 21 | from CIE Lab colors. This a pretty serious abstraction of the 22 | original intention of a \code{coldist} object, which is to use 23 | a combination of spectra data, visual model, and/or receptor-noise 24 | model to calculate perceived chromatic and achromatic distances 25 | between colors. Because CIE Lab color space is an approximately 26 | perceptually uniform color space for human vision, we can calculate 27 | a version of those distances for a human viewer directly from 28 | CIE Lab. A decent option if you want preliminary results, 29 | if you only care about human perception, or if you don't have access 30 | to spectral data. 31 | } 32 | \details{ 33 | I have mixed feelings about this function and would like to 34 | replace it with something a little less hand-wavey. 35 | } 36 | -------------------------------------------------------------------------------- /man/add_image.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_image.R 3 | \name{add_image} 4 | \alias{add_image} 5 | \title{Add a raster image to a plot} 6 | \usage{ 7 | add_image(obj, x = NULL, y = NULL, width = NULL, interpolate = TRUE, angle = 0) 8 | } 9 | \arguments{ 10 | \item{obj}{An array of the dimensions height x width x channels, 11 | such as read in by \link[png:readPNG]{png::readPNG} or \link{readImage}, or the \code{original_img} 12 | and \code{recolored_img} elements of a \code{recolorize} object.} 13 | 14 | \item{x, y}{The x and y coordinates on which the image should be centered.} 15 | 16 | \item{width}{Image width, in x-axis units.} 17 | 18 | \item{interpolate}{Passed to \link[graphics:rasterImage]{graphics::rasterImage}. Use linear 19 | interpolation when scaling the image?} 20 | 21 | \item{angle}{Passed to \link[graphics:rasterImage]{graphics::rasterImage}. The angle (in degrees) 22 | for rotating the image.} 23 | } 24 | \value{ 25 | Nothing; adds an image to the existing plot window. 26 | } 27 | \description{ 28 | Adds a raster image (a 3D array) to an existing plot as an image. 29 | A silly, generic function, but nice for visualization. Sort of like 30 | \link[graphics:points]{graphics::points}, but for images. 31 | } 32 | \examples{ 33 | images <- dir(system.file("extdata", package = "recolorize"), 34 | ".png", full.names = TRUE) 35 | x <- runif(5) 36 | y <- runif(5) 37 | plot(x, y, 38 | xlim = range(x) + c(-0.2, 0.2), 39 | ylim = range(y) + c(-0.2, 0.2)) 40 | for (i in 1:length(images)) { 41 | img <- readImage(images[i]) 42 | add_image(img, x[i], y[i], width = 0.1) 43 | } 44 | 45 | } 46 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: recolorize 2 | Title: Color-Based Image Segmentation 3 | Version: 0.2.0 4 | Authors@R: 5 | person(given = "Hannah", 6 | family = "Weller", 7 | role = c("aut", "cre"), 8 | email = "hannahiweller@gmail.com", 9 | comment = c(ORCID = "0000-0002-5252-4282")) 10 | Description: Automatic, semi-automatic, and manual functions for 11 | generating color maps from images. The idea is to simplify 12 | the colors of an image according to a metric that is useful for 13 | the user, using deterministic methods whenever possible. 14 | Many images will be clustered well using the out-of-the-box 15 | functions, but the package also includes a toolbox of functions 16 | for making manual adjustments (layer merging/isolation, blurring, 17 | fitting to provided color clusters or those from another image, etc). 18 | Also includes export methods for other color/pattern analysis packages 19 | (pavo, patternize, colordistance). 20 | License: CC BY 4.0 21 | Encoding: UTF-8 22 | LazyData: true 23 | Roxygen: list(markdown = TRUE) 24 | RoxygenNote: 7.3.1 25 | Imports: 26 | imager, 27 | stats, 28 | png, 29 | pavo, 30 | grDevices, 31 | graphics, 32 | mgcv, 33 | colorRamps, 34 | plotfunctions, 35 | abind, 36 | raster, 37 | plot3D 38 | Depends: 39 | R (>= 3.50) 40 | Suggests: 41 | knitr, 42 | rmarkdown, 43 | sf, 44 | smoothr, 45 | clue, 46 | spatstat.geom, 47 | methods 48 | VignetteBuilder: knitr 49 | URL: https://hiweller.github.io/recolorize/, https://github.com/hiweller/recolorize 50 | BugReports: https://github.com/hiweller/recolorize/issues 51 | -------------------------------------------------------------------------------- /man/match_colors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reorder_colors.R 3 | \name{match_colors} 4 | \alias{match_colors} 5 | \title{Reorder a color palette to best match a reference palette} 6 | \usage{ 7 | match_colors(reference_palette, match_palette, plotting = FALSE) 8 | } 9 | \arguments{ 10 | \item{reference_palette}{The palette whose order to match. Either a character 11 | vector of colors (hex codes or color names) or an nx3 matrix in \strong{sRGB 12 | color space}.} 13 | 14 | \item{match_palette}{The palette to reorder, same formats as 15 | \code{reference_palette}} 16 | 17 | \item{plotting}{Logical. Plot the ordered palettes?} 18 | } 19 | \value{ 20 | A vector of color orders for \code{match_palette}. 21 | } 22 | \description{ 23 | Often for batch processing purposes, it is important to ensure 24 | that color centers fit using different methods are in the same 25 | order. This function reorders a provided color palette (\code{match_palette}) 26 | according a provided reference palette (\code{reference_palette}) by minimizing 27 | their overall distance using the 28 | \href{https://en.wikipedia.org/wiki/Hungarian_algorithm}{Hungarian algorithm} 29 | as implemented by \link[clue:solve_LSAP]{clue::solve_LSAP}. 30 | } 31 | \details{ 32 | If the color palettes are wildly different, the returned order may not be 33 | especially meaningful. 34 | } 35 | \examples{ 36 | ref_palette <- c("mediumblue", "olivedrab", "tomato2", "beige", "chocolate4") 37 | match_palette <- c("#362C34", "#E4D3A9", "#AA4E47", "#809C35", "#49468E") 38 | match_colors(ref_palette, match_palette, plotting = TRUE) 39 | 40 | } 41 | \seealso{ 42 | \link{reorder_colors} 43 | } 44 | -------------------------------------------------------------------------------- /man/imHeatmap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/imDist.R 3 | \name{imHeatmap} 4 | \alias{imHeatmap} 5 | \title{Plot a heatmap of a matrix of color distances} 6 | \usage{ 7 | imHeatmap( 8 | mat, 9 | palette = "default", 10 | main = "", 11 | range = NULL, 12 | legend = TRUE, 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{mat}{A color distance matrix, preferably output of 18 | \code{\link[=imDist]{imDist()}}.} 19 | 20 | \item{palette}{The color palette to be used. Default is blue to 21 | red (\code{colorRamps::blue2red(100)}).} 22 | 23 | \item{main}{Plot title.} 24 | 25 | \item{range}{Range for heatmap values. Defaults to the range of values in the 26 | matrix, but should be set to the same range for all images if comparing 27 | heatmaps.} 28 | 29 | \item{legend}{Logical. Add a continuous color legend?} 30 | 31 | \item{...}{Parameters passed to \code{\link[graphics:image]{graphics::image()}}.} 32 | } 33 | \value{ 34 | Nothing; plots a heatmap of the color residuals. 35 | } 36 | \description{ 37 | Plots the output of \code{\link[=imDist]{imDist()}} as a heatmap. 38 | } 39 | \examples{ 40 | chongi <- system.file("extdata/chongi.png", package = "recolorize") 41 | chongi <- png::readPNG(chongi) 42 | chongi_k <- recolorize(chongi, "k", n = 5) 43 | 44 | recolored_chongi <- constructImage(chongi_k$pixel_assignments, 45 | chongi_k$centers) 46 | d <- imDist(chongi, 47 | recolored_chongi, plotting = FALSE) 48 | 49 | # original flavor 50 | imHeatmap(d) 51 | 52 | # bit offputting 53 | imHeatmap(d, palette = colorRamps::ygobb(100)) 54 | 55 | # just dreadful 56 | imHeatmap(d, palette = colorRamps::primary.colors(100)) 57 | } 58 | -------------------------------------------------------------------------------- /man/reorder_colors.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reorder_colors.R 3 | \name{reorder_colors} 4 | \alias{reorder_colors} 5 | \title{Reorder colors in a recolorize object} 6 | \usage{ 7 | reorder_colors(recolorize_obj, col_order, plotting = FALSE) 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{An object of class \code{recolorize}.} 11 | 12 | \item{col_order}{A numeric vector of the length of the number of color 13 | centers in the \code{recolorize} object specifying the order of the colors.} 14 | 15 | \item{plotting}{Logical. Plot the results?} 16 | } 17 | \value{ 18 | A \code{recolorize} object. 19 | } 20 | \description{ 21 | Often for batch processing purposes, it is important to ensure 22 | that color centers fit using different methods are in the same 23 | order. 24 | } 25 | \details{ 26 | While you can manually specify the \code{col_order} vector, one way to 27 | automatically order the colors according to an external color palette (as 28 | might be needed for batch processing) is to use the \link{match_colors} function, 29 | although it is recommended to double-check the results. 30 | } 31 | \examples{ 32 | img <- system.file("extdata/corbetti.png", package = "recolorize") 33 | rc <- recolorize2(img, cutoff = 45) 34 | ref_palette <- c("mediumblue", "olivedrab", "tomato2", "beige", "grey10") 35 | col_order <- match_colors(ref_palette, rc$centers, plotting = TRUE) 36 | rc2 <- reorder_colors(rc, col_order, plotting = FALSE) 37 | 38 | # the colors are reordered, but not changed to match the reference palette: 39 | plot(rc2) 40 | 41 | # you can also change them to the reference palette: 42 | rc2$centers <- t(grDevices::col2rgb(ref_palette) / 255) 43 | plot(rc2) 44 | } 45 | -------------------------------------------------------------------------------- /R/plotImageArray.R: -------------------------------------------------------------------------------- 1 | #' Plot a 3D array as an RGB image 2 | #' 3 | #' Does what it says on the tin. An extremely simple wrapper for 4 | #' [graphics::rasterImage()], but maintains aspect ratio, removes 5 | #' axes, and reduces margins for cleaner plotting. 6 | #' 7 | #' @param rgb_array A 3D array of RGB values. Preferably output from 8 | #' [png::readPNG()], [jpeg::readJPEG()], 9 | #' [recoloredImage], [constructImage], or [raster_to_array]. 10 | #' @param main Optional title for plot. 11 | #' @param ... Parameters passed to [graphics::plot]. 12 | #' 13 | #' @return No return value; plots image. 14 | #' 15 | #' @examples 16 | #' # make a 100x100 image of random colors 17 | #' random_colors <- array(runif(100 * 100 * 3), 18 | #' dim = c(100, 100, 3)) 19 | #' recolorize::plotImageArray(random_colors) 20 | #' 21 | #' # we can also plot...a real image 22 | #' corbetti <- system.file("extdata/corbetti.png", 23 | #' package = "recolorize") 24 | #' img <- png::readPNG(corbetti) 25 | #' plotImageArray(img) 26 | #' @export 27 | plotImageArray <- function(rgb_array, main = "", ...) { 28 | 29 | # Make sure the array is 3-dimensional 30 | if (length(dim(rgb_array)) != 3 & length(dim(rgb_array)) != 2) { 31 | stop("RGB_array must be an array of three dimensions (pixel rows, 32 | pixel columns, and color channels)") 33 | } 34 | 35 | asp <- dim(rgb_array)[1] / dim(rgb_array)[2] 36 | 37 | # Initialize empty plot window 38 | graphics::plot(0:1, 0:1, type = "n", 39 | ann = F, axes = F, 40 | asp = asp, ...) 41 | 42 | # Use rasterImage to actually plot the image 43 | graphics::rasterImage(rgb_array, 0, 0, 1, 1) 44 | graphics::title(main, line = 0) 45 | 46 | } 47 | -------------------------------------------------------------------------------- /man/adjust_color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_colors.R 3 | \name{adjust_color} 4 | \alias{adjust_color} 5 | \title{Adjust the saturation and brightness of a color} 6 | \usage{ 7 | adjust_color( 8 | rgb_color, 9 | which_colors = "all", 10 | saturation = 1, 11 | brightness = 1, 12 | plotting = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{rgb_color}{Matrix of RGB colors (0-1 scale).} 17 | 18 | \item{which_colors}{The indices of the colors to change. Can be a numeric 19 | vector or "all" to adjust all colors.} 20 | 21 | \item{saturation}{Factor by which to multiply saturation. > 1 = more saturated, 22 | < 1 = less saturated.} 23 | 24 | \item{brightness}{Factor by which to multiply brightness.} 25 | 26 | \item{plotting}{Logical. Plot resulting color palettes?} 27 | } 28 | \value{ 29 | A matrix of adjusted RGB colors. 30 | } 31 | \description{ 32 | Adjusts the saturation and brightness of RGB colors. 33 | } 34 | \examples{ 35 | # generate a palette: 36 | p <- grDevices::palette.colors() 37 | 38 | # convert to RGB using col2rgb, then divide by 255 to get it into a 39 | # 0-1 range: 40 | p <- t(col2rgb(p)/ 255 ) 41 | 42 | # we can adjust the saturation and brightness by the same factor: 43 | p_1 <- adjust_color(p, saturation = 2, 44 | brightness = 1.5, 45 | plotting = TRUE) 46 | 47 | # or we can pass a vector for the factors: 48 | p_2 <- adjust_color(p, 49 | saturation = seq(0, 2, length.out = 9), 50 | plotting = TRUE) 51 | 52 | # or we can target a single color: 53 | p_3 <- adjust_color(p, which_colors = 4, 54 | saturation = 2, brightness = 2, 55 | plotting = TRUE) 56 | 57 | } 58 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: R-CMD-check.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | R-CMD-check: 14 | runs-on: ${{ matrix.config.os }} 15 | 16 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 17 | 18 | strategy: 19 | fail-fast: false 20 | matrix: 21 | config: 22 | - {os: macos-latest, r: 'release'} 23 | - {os: windows-latest, r: 'release'} 24 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 25 | - {os: ubuntu-latest, r: 'release'} 26 | - {os: ubuntu-latest, r: 'oldrel-1'} 27 | 28 | env: 29 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 30 | R_KEEP_PKG_SOURCE: yes 31 | 32 | steps: 33 | - name: Install XQuartz on macOS 34 | if: runner.os == 'macOS' 35 | run: | 36 | brew install --cask xquartz 37 | echo "XQuartz installed" 38 | 39 | - uses: actions/checkout@v4 40 | 41 | - uses: r-lib/actions/setup-pandoc@v2 42 | 43 | - uses: r-lib/actions/setup-r@v2 44 | with: 45 | r-version: ${{ matrix.config.r }} 46 | http-user-agent: ${{ matrix.config.http-user-agent }} 47 | use-public-rspm: true 48 | 49 | - uses: r-lib/actions/setup-r-dependencies@v2 50 | with: 51 | extra-packages: any::rcmdcheck 52 | needs: check 53 | 54 | - uses: r-lib/actions/check-r-package@v2 55 | with: 56 | upload-snapshots: true 57 | build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' 58 | -------------------------------------------------------------------------------- /R/recolorize_to_patternize.R: -------------------------------------------------------------------------------- 1 | #' Convert a recolorize object to a raster object 2 | #' 3 | #' Convert from a `recolorize` object to a list of RasterLayer objects, the 4 | #' format required by the `patternize` package. Note that most of the downstream 5 | #' `patternize` functions that require lists of RasterLayer objects mostly 6 | #' require lists of these lists, so you will probably need to use this function 7 | #' on a list of `recolorize` objects. 8 | #' 9 | #' @param recolorize_obj A `recolorize` object. 10 | #' @param return_background Logical. 11 | #' 12 | #' @details Note that this function does not retain the colors of the layers -- 13 | #' you won't be able to convert back to a recolorize object from this object. 14 | #' 15 | #' @return A list of RasterLayer objects, one per color class. 16 | #' 17 | #' @examples 18 | #' 19 | #' \donttest{ 20 | #' # fit recolorize object: 21 | #' img <- system.file("extdata/ephippigera.png", package = "recolorize") 22 | #' rc <- recolorize2(img) 23 | #' 24 | #' # takes ~10 sec to run: 25 | #' # convert to a raster list: 26 | #' as_raster_list <- recolorize_to_patternize(rc) 27 | #' } 28 | #' 29 | #' @export 30 | recolorize_to_patternize <- function(recolorize_obj, 31 | return_background = FALSE) { 32 | 33 | # convert to a raster first 34 | r <- raster::raster(recolorize_obj$pixel_assignments) 35 | 36 | # iterate through unique components 37 | l <- 1:nrow(recolorize_obj$centers) 38 | 39 | if (return_background) { 40 | l <- c(0, l) 41 | } 42 | 43 | # make a list to store the layers 44 | layer_list <- vector("list", length = length(l)) 45 | 46 | # for every layer... 47 | for (i in 1:length(l)) { 48 | 49 | # store all the coordinates equal to that layer 50 | layer_list[[i]] <- r == l[i] 51 | } 52 | 53 | # voila 54 | return(layer_list) 55 | 56 | } 57 | -------------------------------------------------------------------------------- /R/cielab_coldist.R: -------------------------------------------------------------------------------- 1 | #' Generate a 'coldist' object for CIE Lab colors 2 | #' 3 | #' A stopgap function for generating a [pavo::coldist] object 4 | #' from CIE Lab colors. This a pretty serious abstraction of the 5 | #' original intention of a `coldist` object, which is to use 6 | #' a combination of spectra data, visual model, and/or receptor-noise 7 | #' model to calculate perceived chromatic and achromatic distances 8 | #' between colors. Because CIE Lab color space is an approximately 9 | #' perceptually uniform color space for human vision, we can calculate 10 | #' a version of those distances for a human viewer directly from 11 | #' CIE Lab. A decent option if you want preliminary results, 12 | #' if you only care about human perception, or if you don't have access 13 | #' to spectral data. 14 | #' 15 | #' @param rgbcols An nx3 matrix of RGB colors (rows are colors and 16 | #' columns are R, G, and B channels). 17 | #' 18 | #' @return A [pavo::coldist] object with four columns: the patches 19 | #' being contrasted (columns 1-2), the chromatic contrast (`dS`), 20 | #' and the achromatic contrast (`dL`), all in units of Euclidean 21 | #' distance in CIE Lab space. 22 | #' 23 | #' 24 | #' @details I have mixed feelings about this function and would like to 25 | #' replace it with something a little less hand-wavey. 26 | cielab_coldist <- function(rgbcols) { 27 | 28 | lab_coldist <- data.frame(t(utils::combn(nrow(rgbcols), 2)), 29 | dS = NA, dL = NA) 30 | 31 | colnames(lab_coldist)[1:2] <- c("c1", "c2") 32 | 33 | labcols <- grDevices::convertColor(rgbcols, "sRGB", "Lab") 34 | 35 | for (i in 1:nrow(lab_coldist)) { 36 | ref_idx <- as.numeric(lab_coldist[i, 1:2]) 37 | lab_coldist$dS[i] <- stats::dist(labcols[ref_idx, 2:3]) 38 | lab_coldist$dL[i] <- stats::dist(labcols[ref_idx, 1]) 39 | } 40 | 41 | return(lab_coldist) 42 | } 43 | -------------------------------------------------------------------------------- /man/plot.recolorize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_recolorize.R 3 | \name{plot.recolorize} 4 | \alias{plot.recolorize} 5 | \title{Plot recolorized image results} 6 | \usage{ 7 | \method{plot}{recolorize}(x, ..., plot_original = TRUE, horiz = TRUE, cex_text = 2, sizes = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{An object of class \code{recolorize}, such as 11 | returned by \code{\link[=recolorize]{recolorize()}}, \code{\link[=recluster]{recluster()}}, 12 | \code{\link[=imposeColors]{imposeColors()}}, etc.} 13 | 14 | \item{...}{further arguments passed to \code{plot}.} 15 | 16 | \item{plot_original}{Logical. Plot the original image for comparison?} 17 | 18 | \item{horiz}{Logical. Should plots be stacked vertically or horizontally?} 19 | 20 | \item{cex_text}{Text size for printing color indices. Plotting parameters 21 | passed to \code{[recolorize]{plotColorPalette}}.} 22 | 23 | \item{sizes}{Logical. If \code{TRUE}, color palette is plotted proportional 24 | to the size of each color. If \code{FALSE}, all colors take up an equal 25 | amount of space, and their indices are printed for reference.} 26 | } 27 | \value{ 28 | No return value; plots the original image, recolored image, and 29 | color palette. 30 | } 31 | \description{ 32 | S3 plotting method for objects of class \code{recolorize}. Plots a side-by-side 33 | comparison of an original image and its recolorized version, plus the color 34 | palette used for recoloring. 35 | } 36 | \examples{ 37 | corbetti <- system.file("extdata/corbetti.png", 38 | package = "recolorize") 39 | 40 | corbetti_recolor <- recolorize(corbetti, method = "hist", 41 | bins = 2, plotting = FALSE) 42 | 43 | # unscaled color palette 44 | plot(corbetti_recolor) 45 | 46 | # scaled color palette 47 | plot(corbetti_recolor, sizes = TRUE) 48 | 49 | } 50 | -------------------------------------------------------------------------------- /man/thresholdRecolor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/thresholdRecolor.R 3 | \name{thresholdRecolor} 4 | \alias{thresholdRecolor} 5 | \title{Drop minor colors from a recolorize object} 6 | \usage{ 7 | thresholdRecolor(recolorize_obj, pct = 0.05, plotting = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{An object of class \code{recolorize}.} 11 | 12 | \item{pct}{The proportion cutoff (0-1) for dropping color patches. The 13 | higher this value is, the more/larger color centers will be dropped.} 14 | 15 | \item{plotting}{Logical. Plot the results?} 16 | 17 | \item{...}{Further arguments passed to \link{imposeColors}, which is 18 | called for refitting a new recolorize object for the reduced set of 19 | clusters.} 20 | } 21 | \value{ 22 | A \code{recolorize} object. 23 | } 24 | \description{ 25 | Drops color patches whose cumulative sum (as a proportion of total pixels 26 | assigned) is equal to or less than \code{pct}, so that only the dominant 27 | color patches remain, and refits the object with the reduced set of 28 | color centers Useful for dropping spurious detail colors. 29 | } 30 | \details{ 31 | This function is fairly simple in execution: the color centers are 32 | arranged by their sizes, largest to smallest, and their cumulative sum is 33 | calculated. The minimum number of color centers to reach a cumulative sum 34 | equal to or greater than the cutoff (\code{1 - pct}) is retained, and these 35 | dominant colors are used to re-fit the image. Despite being 36 | straightforward, this can be a surprisingly useful function. 37 | } 38 | \examples{ 39 | img <- system.file("extdata/fulgidissima.png", package = "recolorize") 40 | init_fit <- recolorize(img, bins = 3) 41 | thresh_fit <- thresholdRecolor(init_fit, pct = 0.1) 42 | 43 | # if you take it too far, you just get one color back: 44 | thresh_fit_oops <- thresholdRecolor(init_fit, pct = 1) 45 | } 46 | -------------------------------------------------------------------------------- /man/colorClustersHist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorClusters.R 3 | \name{colorClustersHist} 4 | \alias{colorClustersHist} 5 | \title{Cluster pixel colors using histogram binning} 6 | \usage{ 7 | colorClustersHist( 8 | pixel_matrix, 9 | bins = 3, 10 | color_space = c("Lab", "sRGB", "Luv", "HSV"), 11 | ref_white = "D65", 12 | bin_avg = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{pixel_matrix}{2D matrix of pixels to classify (rows = pixels, columns = 17 | channels).} 18 | 19 | \item{bins}{Number of bins for each channel OR a vector of length 3 with bins 20 | for each channel. \code{bins = 3} will result in 3^3 = 27 bins; \code{bins = c(2, 2, 3)} 21 | will result in 2\emph{2}3 = 12 bins (2 red, 2 green, 3 blue if you're in RGB 22 | color space), etc.} 23 | 24 | \item{color_space}{Color space in which to cluster colors, passed to 25 | \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", or "Luv". 26 | Default is "Lab", a perceptually uniform (for humans) color space.} 27 | 28 | \item{ref_white}{Reference white for converting to different color spaces. 29 | D65 (the default) corresponds to standard daylight.} 30 | 31 | \item{bin_avg}{Logical. Return the color centers as the average of the pixels 32 | assigned to the bin (the default), or the geometric center of the bin?} 33 | } 34 | \value{ 35 | A list with the following elements: 36 | \enumerate{ 37 | \item \code{pixel_assignments}: A vector of color center assignments for 38 | each pixel. 39 | \item \code{centers}: A matrix of color centers. 40 | \item \code{sizes}: The number of pixels assigned to each cluster. 41 | } 42 | } 43 | \description{ 44 | Clusters pixel colors by dividing color space up into specified bins, 45 | then taking the average color of all the pixels within that bin. 46 | } 47 | \details{ 48 | Called by \code{\link[=colorClusters]{colorClusters()}}. See that documentation for 49 | examples. 50 | } 51 | -------------------------------------------------------------------------------- /man/splitByColor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/splitByColor.R 3 | \name{splitByColor} 4 | \alias{splitByColor} 5 | \title{Split color clusters in a recolorize object into layers} 6 | \usage{ 7 | splitByColor( 8 | recolorize_obj, 9 | layers = "all", 10 | plot_method = c("overlay", "binary", "colormask", "none") 11 | ) 12 | } 13 | \arguments{ 14 | \item{recolorize_obj}{A recolorize object from \code{\link[=recolorize]{recolorize()}}, 15 | \code{\link[=recluster]{recluster()}}, or \code{\link[=imposeColors]{imposeColors()}}.} 16 | 17 | \item{layers}{Either \code{"all"} or a numeric vector of which color centers to 18 | return.} 19 | 20 | \item{plot_method}{Plotting method for plotting the color layers. Options 21 | are\code{"overlay"}, \code{"binary"}, \code{"colormask"}, or \code{"none"}.} 22 | } 23 | \value{ 24 | A list of binary matrices (1/white = color presence, 0/black = color 25 | absence), one per color center. 26 | } 27 | \description{ 28 | Separates color clusters from a \code{\link[=recolorize]{recolorize()}}, 29 | \code{\link[=recluster]{recluster()}}, or \code{\link[=imposeColors]{imposeColors()}} object 30 | into binary masks. 31 | } 32 | \examples{ 33 | # get original fit 34 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 35 | recolored_corbetti <- recolorize::recolorize(corbetti, plotting = TRUE) 36 | 37 | # to reset graphical parameters: 38 | current_par <- graphics::par(no.readonly = TRUE) 39 | 40 | # make a layout 41 | layout(matrix(c(1, 1:9), nrow = 2)) 42 | par(mar = c(0, 0, 2, 0)) 43 | # plot original 44 | plotImageArray(recolored_corbetti$original_img) 45 | 46 | # plot layers 47 | corbetti_layers <- splitByColor(recolored_corbetti, plot_method = "over") 48 | 49 | # plot binary maps 50 | plotImageArray(recolored_corbetti$original_img) 51 | for (i in 1:length(corbetti_layers)) { 52 | plotImageArray(corbetti_layers[[i]]) 53 | } 54 | 55 | graphics::par(current_par) 56 | } 57 | -------------------------------------------------------------------------------- /man/rerun_recolorize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rerun_recolorize.R 3 | \name{rerun_recolorize} 4 | \alias{rerun_recolorize} 5 | \title{Rerun the sequence of calls used to produce a recolorize object} 6 | \usage{ 7 | rerun_recolorize(recolorize_obj, img = "original") 8 | } 9 | \arguments{ 10 | \item{recolorize_obj}{An object of S3 class 'recolorize'.} 11 | 12 | \item{img}{The image on which to call the recolorize functions. If left as 13 | "original" (the default), functions are called on the original image stored 14 | in the recolorize object. Otherwise can be an object taken by the \code{img} 15 | argument of recolorize functions (a path to an image or an image array).} 16 | } 17 | \value{ 18 | A \code{recolorize} object. 19 | } 20 | \description{ 21 | Evaluates the series of calls in the 'call' element of a recolorize object, 22 | either on the original image (default) or on another image. It will almost 23 | always be easier (and better practice) to define a new function that calls a 24 | series of recolorize function in order than to use this function! 25 | } 26 | \details{ 27 | This function utilizes \code{eval} statements to evaluate the calls 28 | that were stored in the \code{call} element of the specified recolorize object. 29 | This makes it potentially more unpredictable than simply defining your own 30 | function, which is preferable. 31 | } 32 | \examples{ 33 | 34 | # list images 35 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 36 | chongi <- system.file("extdata/chongi.png", package = "recolorize") 37 | 38 | # fit a recolorize object by running two functions in a row: 39 | rc <- recolorize(corbetti, bins = 2, plotting = FALSE) 40 | rc <- recluster(rc, cutoff = 45) 41 | 42 | # check out the call structure (a list of commands that were run): 43 | rc$call 44 | 45 | # we can rerun the analysis on the same image (bit pointless): 46 | rerun <- rerun_recolorize(rc) 47 | 48 | # or, we can rerun it on a new image: 49 | rerun_chongi <- rerun_recolorize(rc, img = chongi) 50 | 51 | } 52 | -------------------------------------------------------------------------------- /R/add_image.R: -------------------------------------------------------------------------------- 1 | #' Add a raster image to a plot 2 | #' 3 | #' Adds a raster image (a 3D array) to an existing plot as an image. 4 | #' A silly, generic function, but nice for visualization. Sort of like 5 | #' [graphics::points], but for images. 6 | #' 7 | #' @param obj An array of the dimensions height x width x channels, 8 | #' such as read in by [png::readPNG] or [readImage], or the `original_img` 9 | #' and `recolored_img` elements of a `recolorize` object. 10 | #' @param x,y The x and y coordinates on which the image should be centered. 11 | #' @param width Image width, in x-axis units. 12 | #' @param interpolate Passed to [graphics::rasterImage]. Use linear 13 | #' interpolation when scaling the image? 14 | #' @param angle Passed to [graphics::rasterImage]. The angle (in degrees) 15 | #' for rotating the image. 16 | #' 17 | #' @return Nothing; adds an image to the existing plot window. 18 | #' 19 | #' @examples 20 | #' images <- dir(system.file("extdata", package = "recolorize"), 21 | #' ".png", full.names = TRUE) 22 | #' x <- runif(5) 23 | #' y <- runif(5) 24 | #' plot(x, y, 25 | #' xlim = range(x) + c(-0.2, 0.2), 26 | #' ylim = range(y) + c(-0.2, 0.2)) 27 | #' for (i in 1:length(images)) { 28 | #' img <- readImage(images[i]) 29 | #' add_image(img, x[i], y[i], width = 0.1) 30 | #' } 31 | #' 32 | #' @export 33 | add_image <- function(obj, x = NULL, 34 | y = NULL, 35 | width = NULL, 36 | interpolate = TRUE, 37 | angle = 0){ 38 | 39 | usr <- graphics::par()$usr 40 | pin <- graphics::par()$pin 41 | imdim <- dim(obj) 42 | sf <- imdim[1] / imdim[2] 43 | 44 | w <- width / (usr[2] - usr[1]) * pin[1] 45 | h <- w * sf 46 | hu <- h / pin[2] * (usr[4] - usr[3]) 47 | 48 | graphics::rasterImage(image = obj, 49 | xleft = x - (width / 2), xright = x + (width / 2), 50 | ybottom = y - (hu / 2), ytop = y + (hu/2), 51 | interpolate = interpolate, 52 | angle = angle) 53 | } 54 | -------------------------------------------------------------------------------- /man/plotColorPalette.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotColorPalette.R 3 | \name{plotColorPalette} 4 | \alias{plotColorPalette} 5 | \title{Plot a color palette} 6 | \usage{ 7 | plotColorPalette(centers, sizes = NULL, cex_text = 2, horiz = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{centers}{Colors to plot in palette. Accepts either a character 11 | vector of hex codes or an n x 3 matrix (rows = colors, columns = 12 | channels). Assumes RGB in 0-1 range.} 13 | 14 | \item{sizes}{An optional numeric vector of sizes for scaling each color. If 15 | no sizes are provided, colors are plotted in equal proportions.} 16 | 17 | \item{cex_text}{Size of the numbers displayed on each color, relative to the 18 | default. Passed to \code{\link[graphics:barplot]{graphics::barplot()}}. Text is only plotted if 19 | \code{sizes = NULL}. \code{cex_text = 0} will remove numbering.} 20 | 21 | \item{horiz}{Logical. Should the palette be plotted vertically or 22 | horizontally?} 23 | 24 | \item{...}{Additional parameters passed to \code{\link[graphics:barplot]{graphics::barplot()}}.} 25 | } 26 | \value{ 27 | No return value; plots a rectangular color palette. 28 | } 29 | \description{ 30 | Plots a color palette as a single bar, optionally scaling each color to a 31 | vector of sizes. 32 | } 33 | \details{ 34 | \code{plotColorPalette} does not reorder or convert colors between color spaces, 35 | so users working in other colorspaces should convert to RGB before plotting. 36 | } 37 | \examples{ 38 | # plot 10 random colors 39 | rand_colors <- matrix(runif(30), ncol = 3) 40 | plotColorPalette(rand_colors) 41 | 42 | # plot 10 random colors with arbitrary sizes 43 | sizes <- runif(10, max = 1000) 44 | plotColorPalette(rand_colors, sizes = sizes) 45 | 46 | # reorder to plot smallest to largest 47 | size_order <- order(sizes) 48 | plotColorPalette(rand_colors[size_order, ], 49 | sizes[size_order]) 50 | 51 | # plot a vector of hex colors, turn off numbering 52 | hex_colors <- rgb(rand_colors) 53 | plotColorPalette(hex_colors, cex_text = 0) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /man/wernerColor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wernerColor.R 3 | \name{wernerColor} 4 | \alias{wernerColor} 5 | \title{Remap an image to Werner's nomenclature} 6 | \usage{ 7 | wernerColor( 8 | recolorize_obj, 9 | which_img = c("original", "recolored"), 10 | n_colors = 5 11 | ) 12 | } 13 | \arguments{ 14 | \item{recolorize_obj}{A recolorize object as returned by 15 | \code{\link[=recolorize]{recolorize()}}, \code{\link[=recluster]{recluster()}}, or 16 | \code{\link[=imposeColors]{imposeColors()}}.} 17 | 18 | \item{which_img}{Which image to recolor; one of either "original" or 19 | "recolored".} 20 | 21 | \item{n_colors}{Number of colors to list out in plotting, in order of 22 | size. Ex: \code{n_colors = 5} will plot the 5 largest colors and their names. 23 | All colors are returned as a normal recolorize object regardless of 24 | \code{n_colors}; this only affects the plot.} 25 | } 26 | \value{ 27 | A \code{recolorize} object with an additional list element, \code{werner_names}, 28 | listing the Werner color names for each center. 29 | } 30 | \description{ 31 | Remaps a recolorize object to the colors in Werner's Nomenclature of Colors 32 | by Patrick Syme (1821), one of the first attempts at an objective color 33 | reference in western science, notably used by Charles Darwin. 34 | } 35 | \details{ 36 | See \url{https://www.c82.net/werner/} to check out the original colors. 37 | } 38 | \examples{ 39 | 40 | 41 | # get an initial fit: 42 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 43 | recolored_corbetti <- recolorize(corbetti, plotting = FALSE) 44 | 45 | # recolor original image 46 | corbetti_werner <- wernerColor(recolored_corbetti, 47 | which_img = "original", 48 | n_colors = 6) 49 | 50 | # we can simplify the colors and then do it again: 51 | corbetti_recluster <- recluster(recolored_corbetti, 52 | cutoff = 45, 53 | plot_hclust = FALSE) 54 | corbetti_werner <- wernerColor(corbetti_recluster, 55 | which_img = "recolored") 56 | 57 | } 58 | -------------------------------------------------------------------------------- /R/readImage.R: -------------------------------------------------------------------------------- 1 | #' Read in an image as a 3D array 2 | #' 3 | #' Reads in and processes an image as a 3D array. Extremely simple wrapper for 4 | #' [imager::load.image()], but it strips the depth channel (resulting 5 | #' in a 3D, not 4D, array). This will probably change. 6 | #' 7 | #' @param img_path Path to the image (a string). 8 | #' @param resize Fraction by which to reduce image size. Important for speed. 9 | #' @param rotate Number of degrees to rotate the image. 10 | #' 11 | #' @return 12 | #' A 3D RGB array (pixel rows x pixel columns x color channels). RGB channels 13 | #' are all scaled 0-1, not 0-255. 14 | #' 15 | #' @examples 16 | #' corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 17 | #' img <- readImage(corbetti) 18 | #' plotImageArray(img) 19 | #' 20 | #' @export 21 | readImage <- function(img_path, resize = NULL, rotate = NULL) { 22 | 23 | # read in image 24 | img_ext <- tolower(tools::file_ext(img_path)) 25 | if (img_ext %in% c("jpeg", "jpg", "png", "bmp", "tif", "tiff")) { 26 | img <- imager::load.image(img_path) 27 | } else { 28 | stop("Image must be either JPG, PNG, TIFF, or BMP") 29 | } 30 | 31 | # resize if specified 32 | if (!is.null(resize)) { 33 | img <- imager::imresize(img, scale = resize, interpolation = 6) 34 | } 35 | 36 | # rotate if specified 37 | if (!is.null(rotate)) { 38 | img <- imager::imrotate(img, angle = rotate) 39 | } 40 | 41 | # undo what cimg does for some reason 42 | img <- imager::imrotate(img, -90) 43 | 44 | # drop depth channel 45 | # i don't want to talk about this 46 | # someday we'll do it all with cimg objects 47 | temp <- array(dim = dim(img)[c(1:2, 4)]) 48 | temp <- img[ , , 1, ] 49 | 50 | # flip the image 51 | # this is a bit slow! 52 | # another reason to switch to all cimg objects! 53 | # imager is just not friendly to me 54 | if (length(dim(temp)) == 3) { 55 | temp[ , , ] <- apply(temp, 3, function(mat) mat[ , ncol(mat):1, drop=FALSE]) 56 | } else if (length(dim(temp)) == 2) { 57 | temp <- temp[ , ncol(temp):1, drop=FALSE] 58 | } 59 | 60 | if (max(temp) > 1) { 61 | temp <- temp / max(temp) 62 | } 63 | 64 | img <- temp 65 | rm(temp) 66 | 67 | return(img) 68 | 69 | } 70 | -------------------------------------------------------------------------------- /R/constructImage.R: -------------------------------------------------------------------------------- 1 | #' Generate an image from pixel assignments and color matrix 2 | #' 3 | #' Combines a matrix of pixel assignments and a corresponding 4 | #' matrix of colors to make a recolored RGB image. 5 | #' 6 | #' @param pixel_assignments A matrix of index values for each pixel which 7 | #' corresponds to `centers` (e.g. a `1` indicates that pixel is the 8 | #' color of the first row of `centers`). Pixels with an index value of 0 9 | #' are considered background. 10 | #' @param centers An n x 3 matrix of color centers where rows are colors 11 | #' and columns are R, G, and B channels. 12 | #' @param background_color A numeric RGB triplet, a hex code, or a named 13 | #' R color for the background. Will be masked by alpha channel (and appear 14 | #' white in the plot window), but will be revealed if the alpha 15 | #' channel is removed. If the alpha channel is a background mask, 16 | #' this is the 'baked in' background color. 17 | #' 18 | #' @return An image (raster) array of the recolored image, 19 | #' with four channels (R, G, B, and alpha). 20 | #' 21 | #' @export 22 | constructImage <- function(pixel_assignments, 23 | centers, 24 | background_color = "white") { 25 | 26 | # make two copies of matrix as a cimg object: 27 | index_cimg <- imager::as.cimg(pixel_assignments) 28 | final_cimg <- index_cimg 29 | 30 | # color the background in 31 | # you won't see this unless you remove the alpha layer: 32 | final_cimg <- imager::colorise(final_cimg, 33 | index_cimg == 0, 34 | background_color) 35 | 36 | # color in every color center: 37 | for (i in 1:nrow(centers)) { 38 | final_cimg <- imager::colorise(final_cimg, 39 | index_cimg == i, 40 | centers[i, ]) 41 | } 42 | 43 | # convert to a regular array: 44 | as_array <- cimg_to_array(final_cimg) 45 | 46 | # and add an alpha channel: 47 | alpha_layer <- pixel_assignments 48 | alpha_layer[which(alpha_layer > 0)] <- 1 49 | as_array <- abind::abind(as_array, 50 | alpha_layer, 51 | along = 3) 52 | 53 | # beep boop: 54 | return(as_array) 55 | 56 | } 57 | -------------------------------------------------------------------------------- /man/blurImage.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/blurImage.R 3 | \name{blurImage} 4 | \alias{blurImage} 5 | \title{Blur an image} 6 | \usage{ 7 | blurImage( 8 | img, 9 | blur_function = c("medianblur", "isoblur", "blur_anisotropic", "boxblur", "boxblur_xy"), 10 | ..., 11 | plotting = TRUE 12 | ) 13 | } 14 | \arguments{ 15 | \item{img}{An image array, as read in by \link[png:readPNG]{png::readPNG} or \link{readImage}.} 16 | 17 | \item{blur_function}{A string matching the name of an imager blur function. 18 | One of c("isoblur", "medianblur", "blur_anisotropic", "boxblur", 19 | "boxblur_xy").} 20 | 21 | \item{...}{Parameters passed to whichever \code{blur_function} is called.} 22 | 23 | \item{plotting}{Logical. Plot the blurred image next to the input 24 | for comparison?} 25 | } 26 | \value{ 27 | An image array of the blurred image. 28 | } 29 | \description{ 30 | Blurs an image using the one of five blur functions in \code{imager}. 31 | Useful for decreasing image noise. 32 | } 33 | \details{ 34 | The parameters passed with the \code{...} argument are specific 35 | to each of the five blur functions; see their documentation for what to 36 | specify: \link[imager:isoblur]{imager::isoblur}, \link[imager:medianblur]{imager::medianblur}, \link[imager:boxblur]{imager::boxblur}, 37 | \link[imager:blur_anisotropic]{imager::blur_anisotropic}, \link[imager:boxblur_xy]{imager::boxblur_xy}. The \code{medianblur} and 38 | \code{blur_anisotropic} functions are best for preserving edges. 39 | } 40 | \examples{ 41 | img_path <- system.file("extdata/fulgidissima.png", package = "recolorize") 42 | img <- readImage(img_path) 43 | median_img <- blurImage(img, "medianblur", n = 5, threshold = 0.5) 44 | anisotropic_img <- blurImage(img, "blur_anisotropic", 45 | amplitude = 5, sharpness = 0.1) 46 | boxblur_img <- blurImage(img, "boxblur", boxsize = 5) 47 | 48 | # save current graphical parameters: 49 | current_par <- graphics::par(no.readonly = TRUE) 50 | graphics::layout(matrix(1:4, nrow = 1)) 51 | 52 | plotImageArray(img, "original") 53 | plotImageArray(median_img, "median") 54 | plotImageArray(anisotropic_img, "anisotropic") 55 | plotImageArray(boxblur_img, "boxblur") 56 | 57 | # and reset: 58 | graphics::par(current_par) 59 | } 60 | -------------------------------------------------------------------------------- /man/backgroundIndex.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/backgroundIndex.R 3 | \name{backgroundIndex} 4 | \alias{backgroundIndex} 5 | \title{Index and remove background pixels for color clustering} 6 | \usage{ 7 | backgroundIndex(img, bg_condition) 8 | } 9 | \arguments{ 10 | \item{img}{An image array, preferably the output of \code{\link[png:readPNG]{png::readPNG()}}, 11 | \code{\link[jpeg:readJPEG]{jpeg::readJPEG()}}, or \code{link[recolorize]{readImage}}.} 12 | 13 | \item{bg_condition}{Background condition, output of 14 | \code{\link[=backgroundCondition]{backgroundCondition()}}.} 15 | } 16 | \value{ 17 | A list with the following elements: 18 | \enumerate{ 19 | \item \code{flattened_img}: The original image, flattened into a 2D matrix 20 | (rows = pixels, columns = channels). 21 | \item \code{img_dims}: Dimensions of the original image. 22 | \item \code{non_bg}: Pixels from \code{flattened_img} that fall outside the 23 | background masking conditions. Used for further color clustering and 24 | analysis. 25 | \item \code{idx}: 2D (row-column) indices for background pixels. 26 | \item \code{idx_flat}: Same as \code{idx}, but flattened to vector order. 27 | } 28 | } 29 | \description{ 30 | Largely internal function for identifying, indexing, and removing background 31 | pixels from an image. 32 | } 33 | \details{ 34 | This function flattens a 3-channel image into a 2D matrix before indexing and 35 | removing background pixels to take advantage of faster indexing procedures. 36 | The \code{idx}, \code{idx_flat}, and \code{img_dims} elements are used to reconstruct the 37 | original and recolored images by other functions. 38 | } 39 | \examples{ 40 | # get image path and read in image 41 | img_path <- system.file("extdata/chongi.png", package = "recolorize") 42 | img <- png::readPNG(img_path) 43 | recolorize::plotImageArray(img) 44 | 45 | # generate a white background condition 46 | bg_condition <- backgroundCondition(lower = rep(0.9, 3), 47 | upper = rep(1, 3)) 48 | 49 | # index background pixels 50 | bg_indexed <- backgroundIndex(img, bg_condition) 51 | 52 | # we can reconstruct the original image from the flattened array 53 | img2 <- bg_indexed$flattened_img 54 | dim(img2) <- bg_indexed$img_dims 55 | 56 | # notice the original background color (light gray) now shows 57 | recolorize::plotImageArray(img2) 58 | 59 | } 60 | -------------------------------------------------------------------------------- /R/medianColors.R: -------------------------------------------------------------------------------- 1 | #' Change color centers to median color of all pixels assigned to it 2 | #' 3 | #' By default, recolorize sets the centers of each color patch to the average 4 | #' (mean) color of all pixels assigned to it. This can sometimes result in colors 5 | #' that look washed out, especially in cases where a region is very shiny (e.g. 6 | #' black with white reflective highlights will average to grey). In these cases, 7 | #' switching to median colors may be either more accurate or more visually 8 | #' pleasing. 9 | #' 10 | #' @param recolorize_obj A `recolorize` class object. 11 | #' @param plotting Logical. Plot results? 12 | #' 13 | #' @return A `recolorize` object, with median colors instead of average colors 14 | #' in the `centers` attribute. 15 | #' 16 | #' @export 17 | medianColors <- function(recolorize_obj, plotting = TRUE) { 18 | 19 | # make a new matrix for colors 20 | median_ctrs <- recolorize_obj$centers 21 | 22 | # calculate median colors 23 | for (i in 1:nrow(recolorize_obj$centers)) { 24 | idx <- which(recolorize_obj$pixel_assignments == i) 25 | px <- recolorize_obj$original_img[idx] 26 | as_rgb <- grDevices::col2rgb(px) / 255 27 | median_color <- apply(as_rgb, 1, stats::median) 28 | median_ctrs[i, ] <- median_color 29 | } 30 | 31 | if (plotting) { 32 | # reset graphical parameters when function exits: 33 | current_par <- graphics::par(no.readonly = TRUE) 34 | on.exit(graphics::par(current_par)) 35 | 36 | graphics::layout(matrix(1:4, 1, 4), 37 | widths = c(0.4, 0.1, 0.1, 0.4)) 38 | 39 | # original 40 | # plotting image 41 | graphics::par(mar = c(0, 0, 2, 0)) 42 | original <- constructImage(recolorize_obj$pixel_assignments, 43 | recolorize_obj$centers) 44 | plotImageArray(original, main = "average colors") 45 | 46 | # plotting palette 47 | graphics::par(mar = rep(0.5, 4)) 48 | plotColorPalette(recolorize_obj$centers, horiz = FALSE) 49 | 50 | # median 51 | # plotting palette 52 | graphics::par(mar = rep(0.5, 4)) 53 | plotColorPalette(median_ctrs, horiz = FALSE) 54 | 55 | # plotting image 56 | graphics::par(mar = c(0, 0, 2, 0)) 57 | original <- constructImage(recolorize_obj$pixel_assignments, 58 | median_ctrs) 59 | plotImageArray(original, main = "median colors") 60 | } 61 | 62 | # swap out centers and return object 63 | recolorize_obj$centers <- median_ctrs 64 | return(recolorize_obj) 65 | } 66 | -------------------------------------------------------------------------------- /R/raster_array_conversions.R: -------------------------------------------------------------------------------- 1 | #' Convert from a (small-r) raster object to an RGB array 2 | #' 3 | #' Recreates the original numeric array from a `raster` object created 4 | #' by [grDevices::as.raster]. Not to be confused with the `Raster*` classes 5 | #' used by the `raster` package. 6 | #' 7 | #' @param raster_obj A matrix of hex codes as output by [grDevices::as.raster]. 8 | #' @param alpha Logical. If there is an alpha channel, retain it in the array? 9 | #' 10 | #' @return A numeric RGB array (0-1 range). 11 | #' 12 | #' @export 13 | raster_to_array <- function(raster_obj, alpha = TRUE) { 14 | 15 | # convert to matrix and to RGB triplets in 0-1 range: 16 | o1 <- as.matrix(raster_obj) 17 | o2 <- grDevices::col2rgb(o1, alpha = alpha) / 255 18 | 19 | # make a blank array of correct dimensions: 20 | im_array <- array(NA, dim = c(dim(raster_obj), nrow(o2))) 21 | 22 | # fill it out: 23 | for (i in 1:nrow(o2)) { 24 | im_array[ , , i] <- o2[i, ] 25 | } 26 | 27 | # and return 28 | return(im_array) 29 | } 30 | 31 | #' Convert from an array to a raster stack 32 | #' 33 | #' Convert from an image array to a raster stack, optionally using the alpha 34 | #' channel as a mask. 35 | #' 36 | #' @param img_array An RGB array. 37 | #' @param type Type of Raster* object to return. One of either "stack" 38 | #' ([raster::stack]) or "brick" ([raster::brick]). 39 | #' @param alpha_mask Logical. Use the alpha channel as a background mask? 40 | #' @param return_alpha Logical. Return the alpha channel as a layer? 41 | #' 42 | #' @return A Raster* object, either `RasterStack` or `RasterBrick` depending 43 | #' on the `type` argument. 44 | array_to_RasterStack <- function(img_array, 45 | type = c("stack", "brick"), 46 | alpha_mask = TRUE, 47 | return_alpha = FALSE) { 48 | 49 | requireNamespace("raster") 50 | 51 | type <- match.arg(type) 52 | 53 | r <- apply(img_array * 255, 3, raster::raster) 54 | 55 | if (type == "stack") { 56 | r2 <- raster::stack(r) 57 | } else { 58 | r2 <- raster::brick(r) 59 | } 60 | 61 | output <- r2 62 | 63 | if (alpha_mask) { 64 | 65 | if (dim(r2)[3] != 4) { 66 | warning("No alpha channel included; not masking output") 67 | } else { 68 | r3 <- raster::mask(raster::subset(r2, 1:3), 69 | raster::subset(r2, 4), 70 | maskvalue = 0) 71 | output <- r3 72 | } 73 | } 74 | 75 | raster::crs(output) <- "+proj=longlat" 76 | 77 | return(output) 78 | 79 | } 80 | -------------------------------------------------------------------------------- /man/recolorize_adjacency.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize_adjacency.R 3 | \name{recolorize_adjacency} 4 | \alias{recolorize_adjacency} 5 | \title{Run \code{pavo}'s adjacency and boundary strength analysis on a \code{recolorize} 6 | object} 7 | \usage{ 8 | recolorize_adjacency( 9 | recolorize_obj, 10 | xscale = 1, 11 | coldist = "default", 12 | hsl = "default", 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{recolorize_obj}{A \code{recolorize} object.} 18 | 19 | \item{xscale}{The length of the x-axis, in preferred units. Passed to 20 | \link[pavo:adjacent]{pavo::adjacent}.} 21 | 22 | \item{coldist}{A \link[pavo:coldist]{pavo::coldist} object; otherwise, this argument 23 | is ignored and a \code{coldist} object for human vision is calculated from 24 | RGB colors converted to CIE Lab using \link{cielab_coldist}.} 25 | 26 | \item{hsl}{A dataframe with \code{patch}, \code{hue}, \code{sat} and \code{lum} columns 27 | specifying the HSL values for each color patch, to be 28 | passed to \link[pavo:adjacent]{pavo::adjacent}. Otherwise, this argument 29 | is ignored and HSL values are calculated for human vision from the RGB 30 | colors in the \code{recolorize} object.} 31 | 32 | \item{...}{Further arguments passed to \link[pavo:adjacent]{pavo::adjacent}.} 33 | } 34 | \value{ 35 | The results of \link[pavo:adjacent]{pavo::adjacent}; see that documentation 36 | for the meaning of each specific value. 37 | } 38 | \description{ 39 | Run adjacency (Endler 2012) and boundary strength (Endler et al. 2018) 40 | analysis directly on a \code{recolorize} object, assuming a human viewer 41 | (i.e. using CIE Lab and HSL color distances that correspond to 42 | perceptual distances of human vision). This is achieved by 43 | converting the \code{recolorize} object to a \link[pavo:classify]{pavo::classify} object, 44 | converting the colors to HSL space, and calculating a \link[pavo:coldist]{pavo::coldist} object 45 | for CIE Lab color space before running \link[pavo:adjacent]{pavo::adjacent}. 46 | } 47 | \details{ 48 | Eventually, the plan is to incorporate more sophisticated 49 | color models than using human perceptual color distances, i.e. 50 | by allowing users to match color patches to spectra. However, 51 | this does return reasonable and informative results so long as 52 | human vision is an appropriate assumption for the image data. 53 | } 54 | \examples{ 55 | img <- system.file("extdata/chongi.png", package = "recolorize") 56 | recolorize_obj <- recolorize(img, method = "k", n = 2) 57 | recolorize_adjacency(recolorize_obj) 58 | 59 | } 60 | \seealso{ 61 | \link[pavo:adjacent]{pavo::adjacent}, \link{classify_recolorize} 62 | } 63 | -------------------------------------------------------------------------------- /man/plotColorClusters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plotColorClusters.R 3 | \name{plotColorClusters} 4 | \alias{plotColorClusters} 5 | \title{Plot color clusters in a color space} 6 | \usage{ 7 | plotColorClusters( 8 | centers, 9 | sizes, 10 | scaling = 10, 11 | plus = 0, 12 | color_space = "sRGB", 13 | phi = 35, 14 | theta = 60, 15 | alpha = 0.5, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{centers}{A matrix of color centers, with rows for centers and columns 21 | as channels. These are interpreted as coordinates.} 22 | 23 | \item{sizes}{A vector of color sizes. Can be relative or absolute; it's going 24 | to be scaled for plotting.} 25 | 26 | \item{scaling}{Factor for scaling the cluster sizes. If your clusters are 27 | way too big or small on the plot, tinker with this.} 28 | 29 | \item{plus}{Value to add to each scaled cluster size; can be helpful for 30 | seeing small or empty bins when they are swamped by larger clusters.} 31 | 32 | \item{color_space}{The color space of the centers. Important for setting the 33 | axis ranges and for converting the colors into hex codes for plotting. The 34 | function assumes that the \code{centers} argument is already in this color space.} 35 | 36 | \item{phi, theta}{Viewing angles (in degrees).} 37 | 38 | \item{alpha}{Transparency (0-1 range).} 39 | 40 | \item{...}{Further parameters passed to \link[plot3D:scatter]{plot3D::scatter3D}.} 41 | } 42 | \value{ 43 | Nothing; plots a 3D scatterplot of color clusters, with corresponding 44 | colors and sizes. 45 | } 46 | \description{ 47 | Plots color clusters in a 3D color space. 48 | } 49 | \details{ 50 | This function does very little on your behalf (e.g. labeling the 51 | axes, setting the axis ranges, trying to find nice scaling parameters, 52 | etc). You can pass those parameters using the \code{...} function to 53 | \link[plot3D:scatter]{plot3D::scatter3D}, which is probably a good idea. 54 | } 55 | \examples{ 56 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 57 | init_fit <- recolorize(corbetti, 58 | color_space = "Lab", 59 | method = "k", 60 | n = 30) 61 | 62 | # we still have to convert to Lab color space first, since the centers are always RGB: 63 | centers <- grDevices::convertColor(init_fit$centers, "sRGB", "Lab") 64 | plotColorClusters(centers, init_fit$sizes, 65 | scaling = 25, 66 | color_space = "Lab", 67 | xlab = "Luminance", 68 | ylab = "a (red-green)", 69 | zlab = "b (blue-yellow)", 70 | cex.lab = 0.5) 71 | } 72 | -------------------------------------------------------------------------------- /R/adjust_colors.R: -------------------------------------------------------------------------------- 1 | #' Adjust the saturation and brightness of a color 2 | #' 3 | #' Adjusts the saturation and brightness of RGB colors. 4 | #' 5 | #' @param rgb_color Matrix of RGB colors (0-1 scale). 6 | #' @param which_colors The indices of the colors to change. Can be a numeric 7 | #' vector or "all" to adjust all colors. 8 | #' @param saturation Factor by which to multiply saturation. > 1 = more saturated, 9 | #' < 1 = less saturated. 10 | #' @param brightness Factor by which to multiply brightness. 11 | #' @param plotting Logical. Plot resulting color palettes? 12 | #' 13 | #' @return A matrix of adjusted RGB colors. 14 | #' 15 | #' @examples 16 | #' # generate a palette: 17 | #' p <- grDevices::palette.colors() 18 | #' 19 | #' # convert to RGB using col2rgb, then divide by 255 to get it into a 20 | #' # 0-1 range: 21 | #' p <- t(col2rgb(p)/ 255 ) 22 | #' 23 | #' # we can adjust the saturation and brightness by the same factor: 24 | #' p_1 <- adjust_color(p, saturation = 2, 25 | #' brightness = 1.5, 26 | #' plotting = TRUE) 27 | #' 28 | #' # or we can pass a vector for the factors: 29 | #' p_2 <- adjust_color(p, 30 | #' saturation = seq(0, 2, length.out = 9), 31 | #' plotting = TRUE) 32 | #' 33 | #' # or we can target a single color: 34 | #' p_3 <- adjust_color(p, which_colors = 4, 35 | #' saturation = 2, brightness = 2, 36 | #' plotting = TRUE) 37 | #' 38 | #' @export 39 | adjust_color <- function(rgb_color, 40 | which_colors = "all", 41 | saturation = 1, 42 | brightness = 1, 43 | plotting = FALSE) { 44 | 45 | original_rgb <- rgb_color 46 | 47 | if (length(which_colors) == 1) { 48 | if (which_colors == "all") { 49 | which_colors <- 1:nrow(rgb_color) 50 | } 51 | } 52 | 53 | # convert to HSV 54 | rgb_color_temp <- matrix(rgb_color[which_colors, ], ncol = 3) 55 | as_hsv <- col2col(rgb_color_temp, to = "HSV") 56 | 57 | # multiply 58 | as_hsv[ , 2] <- as_hsv[ , 2] * saturation 59 | as_hsv[ , 3] <- as_hsv[ , 3] * brightness 60 | 61 | # rescale 62 | as_hsv[which(as_hsv > 1)] <- 1 63 | 64 | # convert to RGB 65 | as_rgb <- col2col(as_hsv, "HSV", "sRGB") 66 | 67 | rgb_color[which_colors, ] <- as_rgb 68 | 69 | if (plotting) { 70 | 71 | # courtesy: 72 | current_par <- graphics::par(no.readonly = TRUE) 73 | on.exit(graphics::par(current_par)) 74 | 75 | graphics::layout(matrix(1:2, nrow = 2)) 76 | graphics::par(mar = rep(1, 4)) 77 | plotColorPalette(original_rgb) 78 | plotColorPalette(rgb_color) 79 | 80 | } 81 | 82 | # spit out 83 | return(rgb_color) 84 | } 85 | -------------------------------------------------------------------------------- /man/backgroundCondition.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/backgroundCondition.R 3 | \name{backgroundCondition} 4 | \alias{backgroundCondition} 5 | \title{Generate a background condition for masking} 6 | \usage{ 7 | backgroundCondition( 8 | lower = NULL, 9 | upper = NULL, 10 | center = NULL, 11 | radius = NULL, 12 | transparent = NULL, 13 | alpha_channel = FALSE, 14 | quietly = TRUE 15 | ) 16 | } 17 | \arguments{ 18 | \item{lower, upper}{RGB triplet ranges for setting a bounding box of pixels to mask.} 19 | 20 | \item{center, radius}{RGB triplet and radius (as a proportion) for masking 21 | pixels within a spherical range.} 22 | 23 | \item{transparent}{Logical or \code{NULL}. Use transparency to mask? Requires an 24 | alpha channel.} 25 | 26 | \item{alpha_channel}{Logical. Is there an alpha channel?} 27 | 28 | \item{quietly}{Logical. Print a message about background masking parameters?} 29 | } 30 | \value{ 31 | A list with background masking parameters. Can be one of 4 classes: 32 | \enumerate{ 33 | \item \code{bg_rect}: If \code{lower} and \code{upper} are specified. 34 | \item \code{bg_sphere}: If \code{center} and \code{radius} are specified. 35 | \item \code{bg_t}: If \code{transparent} is \code{TRUE} and there is an alpha channel 36 | with transparent pixels. 37 | \item \code{bg_none}: If no background masking is specified (or transparency 38 | was specified but there are no transparent pixels). 39 | } 40 | } 41 | \description{ 42 | Internal function for parsing potential background conditions. Prioritizes 43 | transparency masking if conflicting options are provided. See details. 44 | } 45 | \details{ 46 | Prioritizes transparency. If \code{transparency = TRUE} but other options (such as 47 | \code{lower} and \code{upper}) are specified, then only transparent pixels will be masked. 48 | If \code{transparency = TRUE} but there is no alpha channel (as in a JPEG image), 49 | this flag is ignored and other options (\code{lower} and \code{upper} or \code{center} and \code{radius}) 50 | are used instead. 51 | 52 | This is an internal convenience function sourced by \code{\link[=backgroundIndex]{backgroundIndex()}}. 53 | } 54 | \examples{ 55 | 56 | # masking a white background: 57 | backgroundCondition(lower = rep(0.9, 3), upper = rep(1, 3), quietly = FALSE) 58 | 59 | # masking transparent pixels: 60 | backgroundCondition(transparent = TRUE, alpha_channel = TRUE, quietly = FALSE) 61 | 62 | # oops, no alpha channel: 63 | backgroundCondition(transparent = TRUE, alpha_channel = FALSE, quietly = FALSE) 64 | 65 | # oops, no alpha channel, but with white background as a fallback: 66 | backgroundCondition(lower = rep(0.9, 3), upper = rep(1, 3), 67 | transparent = TRUE, alpha_channel = FALSE, 68 | quietly = FALSE) 69 | 70 | } 71 | -------------------------------------------------------------------------------- /man/assignPixels.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/assignPixels.R 3 | \name{assignPixels} 4 | \alias{assignPixels} 5 | \title{Assign a 2D matrix of pixels to specified colors} 6 | \usage{ 7 | assignPixels( 8 | centers, 9 | pixel_matrix, 10 | color_space = "Lab", 11 | ref_white = "D65", 12 | adjust_centers = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{centers}{Matrix of color centers (rows = colors, columns = channels).} 17 | 18 | \item{pixel_matrix}{Matrix of pixel colors (rows = pixels, columns = channels).} 19 | 20 | \item{color_space}{Color space in which to minimize distances, passed to 21 | \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", "Luv", or 22 | "XYZ". Default is "Lab", a perceptually uniform (for humans) color space.} 23 | 24 | \item{ref_white}{Reference white for converting to different color spaces. 25 | D65 (the default) corresponds to standard daylight.} 26 | 27 | \item{adjust_centers}{Logical. Should the returned color clusters be the 28 | average value of the pixels assigned to that cluster? See details.} 29 | } 30 | \value{ 31 | A list of class \code{color_clusters}, containing: 32 | \enumerate{ 33 | \item \code{pixel_assignments}: The color center assignment for each pixel. 34 | \item \code{centers}: A matrix of color centers. If \code{adjust_centers = FALSE}, this will be identical to the input of \code{centers}. 35 | \item \code{sizes}: The number of pixels assigned to each cluster. 36 | } 37 | } 38 | \description{ 39 | Assign a 2D matrix of pixels to specified colors 40 | } 41 | \details{ 42 | This is a largely internal function called by \code{\link[=imposeColors]{imposeColors()}} 43 | for recoloring an image based on extrinsic colors. If \code{adjust_centers = TRUE}, 44 | then after assigning pixels to given color centers, the location of each color center 45 | is replaced by the average color of all the pixels assigned to that center. 46 | } 47 | \examples{ 48 | 49 | # RGB extremes (white, black, red, green, blue, yellow, magenta, cyan) 50 | ctrs <- matrix(c(1, 1, 1, 51 | 0, 0, 0, 52 | 1, 0, 0, 53 | 0, 1, 0, 54 | 0, 0, 1, 55 | 1, 1, 0, 56 | 1, 0, 1, 57 | 0, 1, 1), byrow = TRUE, ncol = 3) 58 | 59 | # plot it 60 | recolorize::plotColorPalette(ctrs) 61 | 62 | # create a pixel matrix of random colors 63 | pixel_matrix <- matrix(runif(3000), ncol = 3) 64 | 65 | # assign pixels 66 | reassigned <- recolorize::assignPixels(ctrs, pixel_matrix, adjust_centers = TRUE) 67 | recolorize::plotColorPalette(reassigned$centers) 68 | 69 | # if we turn off adjust_centers, the colors remain the same as the inputs: 70 | keep.centers <- recolorize::assignPixels(ctrs, pixel_matrix, adjust_centers = FALSE) 71 | recolorize::plotColorPalette(keep.centers$centers) 72 | 73 | } 74 | -------------------------------------------------------------------------------- /R/rerun_recolorize.R: -------------------------------------------------------------------------------- 1 | #' Rerun the sequence of calls used to produce a recolorize object 2 | #' 3 | #' Evaluates the series of calls in the 'call' element of a recolorize object, 4 | #' either on the original image (default) or on another image. It will almost 5 | #' always be easier (and better practice) to define a new function that calls a 6 | #' series of recolorize function in order than to use this function! 7 | #' 8 | #' @param recolorize_obj An object of S3 class 'recolorize'. 9 | #' @param img The image on which to call the recolorize functions. If left as 10 | #' "original" (the default), functions are called on the original image stored 11 | #' in the recolorize object. Otherwise can be an object taken by the `img` 12 | #' argument of recolorize functions (a path to an image or an image array). 13 | #' 14 | #' @return A `recolorize` object. 15 | #' 16 | #' @details This function utilizes `eval` statements to evaluate the calls 17 | #' that were stored in the `call` element of the specified recolorize object. 18 | #' This makes it potentially more unpredictable than simply defining your own 19 | #' function, which is preferable. 20 | #' 21 | #' @examples 22 | #' 23 | #' # list images 24 | #' corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 25 | #' chongi <- system.file("extdata/chongi.png", package = "recolorize") 26 | #' 27 | #' # fit a recolorize object by running two functions in a row: 28 | #' rc <- recolorize(corbetti, bins = 2, plotting = FALSE) 29 | #' rc <- recluster(rc, cutoff = 45) 30 | #' 31 | #' # check out the call structure (a list of commands that were run): 32 | #' rc$call 33 | #' 34 | #' # we can rerun the analysis on the same image (bit pointless): 35 | #' rerun <- rerun_recolorize(rc) 36 | #' 37 | #' # or, we can rerun it on a new image: 38 | #' rerun_chongi <- rerun_recolorize(rc, img = chongi) 39 | #' 40 | #' @export 41 | rerun_recolorize <- function(recolorize_obj, 42 | img = "original") { 43 | 44 | original_call <- recolorize_obj$call 45 | 46 | # if we're using the original image, recreate it real quick 47 | if(length(img) == 1 && img == "original") { 48 | img <- raster_to_array(recolorize_obj$original_img) 49 | } 50 | 51 | # if there's only one call, just run that (list structure is different) 52 | if (!is.list(recolorize_obj$call)) { 53 | recolorize_obj$call$img <- img 54 | recolorize_object <- eval(recolorize_obj$call) 55 | } else { 56 | # otherwise, initialize the recolorize object 57 | recolorize_obj$call[[1]]$img <- img 58 | recolorize_object <- eval(recolorize_obj$call[[1]]) 59 | recolorize_obj 60 | # and then continuously modify it 61 | for (i in 2:length(recolorize_obj$call)) { 62 | recolorize_obj$call[[i]]$recolorize_obj <- recolorize_object 63 | recolorize_object <- eval(recolorize_obj$call[[i]]) 64 | } 65 | } 66 | recolorize_object$call <- original_call 67 | return(recolorize_object) 68 | } 69 | -------------------------------------------------------------------------------- /R/blurImage.R: -------------------------------------------------------------------------------- 1 | #' Blur an image 2 | #' 3 | #' Blurs an image using the one of five blur functions in `imager`. 4 | #' Useful for decreasing image noise. 5 | #' 6 | #' @param img An image array, as read in by [png::readPNG] or [readImage]. 7 | #' @param blur_function A string matching the name of an imager blur function. 8 | #' One of c("isoblur", "medianblur", "blur_anisotropic", "boxblur", 9 | #' "boxblur_xy"). 10 | #' @param ... Parameters passed to whichever `blur_function` is called. 11 | #' @param plotting Logical. Plot the blurred image next to the input 12 | #' for comparison? 13 | #' @return An image array of the blurred image. 14 | #' 15 | #' @details The parameters passed with the `...` argument are specific 16 | #' to each of the five blur functions; see their documentation for what to 17 | #' specify: [imager::isoblur], [imager::medianblur], [imager::boxblur], 18 | #' [imager::blur_anisotropic], [imager::boxblur_xy]. The `medianblur` and 19 | #' `blur_anisotropic` functions are best for preserving edges. 20 | #' 21 | #' @examples 22 | #' img_path <- system.file("extdata/fulgidissima.png", package = "recolorize") 23 | #' img <- readImage(img_path) 24 | #' median_img <- blurImage(img, "medianblur", n = 5, threshold = 0.5) 25 | #' anisotropic_img <- blurImage(img, "blur_anisotropic", 26 | #' amplitude = 5, sharpness = 0.1) 27 | #' boxblur_img <- blurImage(img, "boxblur", boxsize = 5) 28 | #' 29 | #' # save current graphical parameters: 30 | #' current_par <- graphics::par(no.readonly = TRUE) 31 | #' graphics::layout(matrix(1:4, nrow = 1)) 32 | #' 33 | #' plotImageArray(img, "original") 34 | #' plotImageArray(median_img, "median") 35 | #' plotImageArray(anisotropic_img, "anisotropic") 36 | #' plotImageArray(boxblur_img, "boxblur") 37 | #' 38 | #' # and reset: 39 | #' graphics::par(current_par) 40 | #' @export 41 | blurImage <- function(img, 42 | blur_function = c("medianblur", "isoblur", 43 | "blur_anisotropic", "boxblur", 44 | "boxblur_xy"), 45 | ..., plotting = TRUE) { 46 | 47 | blur_function <- match.arg(blur_function) 48 | c_img <- array_to_cimg(img) 49 | blur_img <- switch(blur_function, 50 | isoblur = imager::isoblur(c_img, ...), 51 | medianblur = imager::medianblur(c_img, ...), 52 | boxblur = imager::boxblur(c_img, ...), 53 | blur_anisotropic = imager::blur_anisotropic(c_img, ...), 54 | boxblur_xy = imager::boxblur_xy(c_img, ...)) 55 | new_img <- cimg_to_array(blur_img) 56 | if (dim(img)[3] == 4) { 57 | new_img <- abind::abind(new_img, img[ , , 4]) 58 | } 59 | 60 | # I don't get why this happens but alas 61 | new_img[which(new_img < 0)] <- 0 62 | new_img[which(new_img >= 1)] <- 1 63 | 64 | # plot if we're plotting 65 | if (plotting) { 66 | 67 | # courtesy: 68 | current_par <- graphics::par(no.readonly = TRUE) 69 | on.exit(graphics::par(current_par)) 70 | 71 | graphics::layout(matrix(1:2, nrow = 1)) 72 | graphics::par(mar = c(0, 0, 2, 0)) 73 | plotImageArray(img, "original") 74 | plotImageArray(new_img, "blurred") 75 | 76 | } 77 | 78 | return(new_img) 79 | 80 | } 81 | -------------------------------------------------------------------------------- /R/plot_recolorize.R: -------------------------------------------------------------------------------- 1 | #' Plot recolorized image results 2 | #' 3 | #' S3 plotting method for objects of class `recolorize`. Plots a side-by-side 4 | #' comparison of an original image and its recolorized version, plus the color 5 | #' palette used for recoloring. 6 | #' 7 | #' @param x An object of class `recolorize`, such as 8 | #' returned by [recolorize()], [recluster()], 9 | #' [imposeColors()], etc. 10 | #' @param plot_original Logical. Plot the original image for comparison? 11 | #' @param horiz Logical. Should plots be stacked vertically or horizontally? 12 | #' @param sizes Logical. If `TRUE`, color palette is plotted proportional 13 | #' to the size of each color. If `FALSE`, all colors take up an equal 14 | #' amount of space, and their indices are printed for reference. 15 | #' @param cex_text Text size for printing color indices. Plotting parameters 16 | #' passed to \code{[recolorize]{plotColorPalette}}. 17 | #' @param ... further arguments passed to `plot`. 18 | #' 19 | #' @return No return value; plots the original image, recolored image, and 20 | #' color palette. 21 | #' 22 | #' @examples 23 | #' corbetti <- system.file("extdata/corbetti.png", 24 | #' package = "recolorize") 25 | #' 26 | #' corbetti_recolor <- recolorize(corbetti, method = "hist", 27 | #' bins = 2, plotting = FALSE) 28 | #' 29 | #' # unscaled color palette 30 | #' plot(corbetti_recolor) 31 | #' 32 | #' # scaled color palette 33 | #' plot(corbetti_recolor, sizes = TRUE) 34 | #' 35 | #' @rdname plot.recolorize 36 | #' @export 37 | plot.recolorize <- function(x, ..., 38 | plot_original = TRUE, 39 | horiz = TRUE, 40 | cex_text = 2, sizes = FALSE) { 41 | 42 | # reset graphical parameters when function exits: 43 | current_par <- graphics::par(no.readonly = TRUE) 44 | on.exit(graphics::par(current_par)) 45 | 46 | # layout 47 | if (plot_original) { 48 | 49 | if(horiz) { 50 | graphics::layout(matrix(c(1, 2, 3), 1, 3), 51 | widths = c(0.42, 0.42, 0.16)) 52 | h <- FALSE 53 | } else { 54 | graphics::layout(matrix(c(1, 2, 3), 3, 1), 55 | heights = c(0.42, 0.42, 0.16)) 56 | h <- TRUE 57 | } 58 | 59 | } else { 60 | 61 | if (horiz) { 62 | graphics::layout(matrix(c(1, 2), 1, 2), 63 | widths = c(0.8, 0.2)) 64 | h <- FALSE 65 | } else { 66 | graphics::layout(matrix(c(1, 2), 2, 1), 67 | heights = c(0.8, 0.2)) 68 | h <- TRUE 69 | } 70 | 71 | } 72 | 73 | # plot original if specified 74 | if (plot_original) { 75 | graphics::par(mar = c(0, 0, 2, 0)) 76 | plotImageArray(x$original_img, 77 | main = "original") 78 | } 79 | 80 | # plotting image 81 | graphics::par(mar = c(0, 0, 2, 0)) 82 | recolored_img <- constructImage(x$pixel_assignments, 83 | x$centers) 84 | plotImageArray(recolored_img, main = "recolored") 85 | 86 | # plotting palette 87 | graphics::par(mar = rep(0.5, 4)) 88 | 89 | if (sizes) { 90 | sizes <- x$sizes 91 | } else { 92 | sizes <- NULL 93 | } 94 | 95 | plotColorPalette(x$centers, horiz = h, 96 | cex_text = cex_text, sizes = sizes) 97 | 98 | } 99 | -------------------------------------------------------------------------------- /R/plotColorClusters.R: -------------------------------------------------------------------------------- 1 | #' Plot color clusters in a color space 2 | #' 3 | #' Plots color clusters in a 3D color space. 4 | #' 5 | #' @param centers A matrix of color centers, with rows for centers and columns 6 | #' as channels. These are interpreted as coordinates. 7 | #' @param sizes A vector of color sizes. Can be relative or absolute; it's going 8 | #' to be scaled for plotting. 9 | #' @param color_space The color space of the centers. Important for setting the 10 | #' axis ranges and for converting the colors into hex codes for plotting. The 11 | #' function assumes that the `centers` argument is already in this color space. 12 | #' @param scaling Factor for scaling the cluster sizes. If your clusters are 13 | #' way too big or small on the plot, tinker with this. 14 | #' @param plus Value to add to each scaled cluster size; can be helpful for 15 | #' seeing small or empty bins when they are swamped by larger clusters. 16 | #' @param phi,theta Viewing angles (in degrees). 17 | #' @param alpha Transparency (0-1 range). 18 | #' @param ... Further parameters passed to [plot3D::scatter3D]. 19 | #' 20 | #' @return Nothing; plots a 3D scatterplot of color clusters, with corresponding 21 | #' colors and sizes. 22 | #' 23 | #' @details This function does very little on your behalf (e.g. labeling the 24 | #' axes, setting the axis ranges, trying to find nice scaling parameters, 25 | #' etc). You can pass those parameters using the `...` function to 26 | #' [plot3D::scatter3D], which is probably a good idea. 27 | #' 28 | #' @examples 29 | #' corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 30 | #' init_fit <- recolorize(corbetti, 31 | #' color_space = "Lab", 32 | #' method = "k", 33 | #' n = 30) 34 | #' 35 | #' # we still have to convert to Lab color space first, since the centers are always RGB: 36 | #' centers <- grDevices::convertColor(init_fit$centers, "sRGB", "Lab") 37 | #' plotColorClusters(centers, init_fit$sizes, 38 | #' scaling = 25, 39 | #' color_space = "Lab", 40 | #' xlab = "Luminance", 41 | #' ylab = "a (red-green)", 42 | #' zlab = "b (blue-yellow)", 43 | #' cex.lab = 0.5) 44 | #' @export 45 | plotColorClusters <- function(centers, sizes, 46 | scaling = 10, 47 | plus = 0, 48 | color_space = "sRGB", 49 | phi = 35, theta = 60, 50 | alpha = 0.5, 51 | ...) { 52 | 53 | # get color vector in RGB 54 | centers_rgb <- col2col(centers, from = color_space, to = "sRGB") 55 | hex_col <- grDevices::rgb(centers_rgb, alpha = alpha) 56 | 57 | # normalize sizes 58 | sizes <- sizes / sum(sizes) 59 | 60 | # make blank plot 61 | plot3D::scatter3D(x = centers[ , 1], 62 | y = centers[ , 2], 63 | z = centers[ , 3], 64 | cex = 0, colkey = FALSE, 65 | phi = phi, theta = theta, 66 | ...) 67 | 68 | # add one point at a time, setting size with the cex argument 69 | for (i in 1:nrow(centers)) { 70 | plot3D::scatter3D(x = centers[i , 1], 71 | y = centers[i , 2], 72 | z = centers[i , 3], 73 | cex = sizes[i] * scaling + plus, 74 | pch = 19, alpha = alpha, 75 | col = hex_col[i], add = TRUE) 76 | } 77 | 78 | # BARE BONES, gang...bare bones 79 | } 80 | -------------------------------------------------------------------------------- /R/thresholdRecolor.R: -------------------------------------------------------------------------------- 1 | #' Drop minor colors from a recolorize object 2 | #' 3 | #' Drops color patches whose cumulative sum (as a proportion of total pixels 4 | #' assigned) is equal to or less than `pct`, so that only the dominant 5 | #' color patches remain, and refits the object with the reduced set of 6 | #' color centers Useful for dropping spurious detail colors. 7 | #' 8 | #' @param recolorize_obj An object of class `recolorize`. 9 | #' @param pct The proportion cutoff (0-1) for dropping color patches. The 10 | #' higher this value is, the more/larger color centers will be dropped. 11 | #' @param plotting Logical. Plot the results? 12 | #' @param ... Further arguments passed to [recolorize::imposeColors], which is 13 | #' called for refitting a new recolorize object for the reduced set of 14 | #' clusters. 15 | #' 16 | #' @details This function is fairly simple in execution: the color centers are 17 | #' arranged by their sizes, largest to smallest, and their cumulative sum is 18 | #' calculated. The minimum number of color centers to reach a cumulative sum 19 | #' equal to or greater than the cutoff (`1 - pct`) is retained, and these 20 | #' dominant colors are used to re-fit the image. Despite being 21 | #' straightforward, this can be a surprisingly useful function. 22 | #' 23 | #' @return A `recolorize` object. 24 | #' 25 | #' @examples 26 | #' img <- system.file("extdata/fulgidissima.png", package = "recolorize") 27 | #' init_fit <- recolorize(img, bins = 3) 28 | #' thresh_fit <- thresholdRecolor(init_fit, pct = 0.1) 29 | #' 30 | #' # if you take it too far, you just get one color back: 31 | #' thresh_fit_oops <- thresholdRecolor(init_fit, pct = 1) 32 | #' @export 33 | thresholdRecolor <- function(recolorize_obj, 34 | pct = 0.05, 35 | plotting = TRUE, 36 | ...) { 37 | # threshold cutoff: 38 | pct <- 1 - pct 39 | 40 | # get sizes: 41 | sizes <- recolorize_obj$sizes 42 | 43 | # get size order: 44 | size_order <- order(sizes, decreasing = TRUE) 45 | 46 | # normalize so we get proportions: 47 | size_norm <- sizes[size_order] / sum(sizes) 48 | 49 | # take cumulative sum, and only take those clusters whose cumulative 50 | # sum is enough to reach the cutoff: 51 | keep_idx <- size_order[1:which(cumsum(size_norm) >= pct)[1]] 52 | 53 | # refit, using those colors 54 | img <- raster_to_array(recolorize_obj$original_img) 55 | refit <- imposeColors(img = img, 56 | centers = recolorize_obj$centers[keep_idx, ], 57 | plotting = FALSE, 58 | ...) 59 | 60 | # plot comparison 61 | if (plotting) { 62 | 63 | # reset graphical parameters when function exits: 64 | current_par <- graphics::par(no.readonly = TRUE) 65 | on.exit(graphics::par(current_par)) 66 | 67 | graphics::layout(matrix(1:4, nrow = 1), 68 | widths = c(0.4, 0.1, 0.1, 0.4)) 69 | initial_fit <- recoloredImage(recolorize_obj, type = "raster") 70 | thresholded_fit <- recoloredImage(refit, type = "raster") 71 | 72 | # plot initial fit 73 | graphics::par(mar = c(0, 0, 2, 0)) 74 | plot(initial_fit); graphics::title("initial fit") 75 | 76 | graphics::par(mar = rep(0.5, 4)) 77 | plotColorPalette(recolorize_obj$centers, 78 | recolorize_obj$sizes, horiz = F) 79 | 80 | # and outcome 81 | plotColorPalette(refit$centers, refit$sizes, horiz = F) 82 | 83 | graphics::par(mar = c(0, 0, 2, 0)) 84 | plot(thresholded_fit); graphics::title("thresholded fit") 85 | } 86 | 87 | # append the call 88 | new_call <- append(recolorize_obj$call, match.call()) 89 | refit$call <- new_call 90 | 91 | recolorize_obj <- refit 92 | 93 | return(recolorize_obj) 94 | 95 | } 96 | -------------------------------------------------------------------------------- /man/colorResiduals.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorResiduals.R 3 | \name{colorResiduals} 4 | \alias{colorResiduals} 5 | \title{Calculate squared residuals for color centers} 6 | \usage{ 7 | colorResiduals( 8 | pixel_matrix, 9 | pixel_assignments, 10 | centers, 11 | color_space = "Lab", 12 | metric = "euclidean", 13 | ref_white = "D65" 14 | ) 15 | } 16 | \arguments{ 17 | \item{pixel_matrix}{2D matrix of pixels to classify (rows = pixels, columns = 18 | channels).} 19 | 20 | \item{pixel_assignments}{A vector of color center assignments for each 21 | pixel. Must match the order of \code{pixel_matrix}.} 22 | 23 | \item{centers}{A matrix of color centers, with rows as centers and 24 | columns as color channels. Rows are assumed to match the index values of 25 | \code{pixel_assignments}, e.g. a pixel assigned \code{1} in the assignment vector 26 | is assigned to the color in the first row of \code{centers}.} 27 | 28 | \item{color_space}{Color space in which to calculate distances. One of 29 | "sRGB", "Lab", "Luv", or "XYZ". Passed to 30 | \code{\link[grDevices:convertColor]{grDevices::convertColor()}}.} 31 | 32 | \item{metric}{Distance metric to be used for calculating pairwise pixel 33 | distances in the given color space; passed to \code{\link[stats:dist]{stats::dist()}}.} 34 | 35 | \item{ref_white}{Passed to \code{\link[grDevices:convertColor]{grDevices::convertColor()}} if 36 | \verb{color_space = "Lab}. Reference white for CIE Lab space.} 37 | } 38 | \value{ 39 | A list with the following attributes: 40 | \enumerate{ 41 | \item \code{sq_residuals}: The squared residual for every pixel in pixel_matrix. 42 | \item \code{tot_residuals}: The sum of all squared residuals. 43 | \item \code{avg_residual}: The average squared residual. 44 | \item \code{residuals_by_center}: A list of squared residuals for every color center. 45 | \item \code{avg_by_center}: The average squared residual for every color center. 46 | } 47 | } 48 | \description{ 49 | Calculates the squared distance between each pixel and its assigned color 50 | center. 51 | } 52 | \examples{ 53 | # RGB extremes (white, black, red, green, blue, yellow, magenta, cyan) 54 | ctrs <- matrix(c(1, 1, 1, 55 | 0, 0, 0, 56 | 1, 0, 0, 57 | 0, 1, 0, 58 | 0, 0, 1, 59 | 1, 1, 0, 60 | 1, 0, 1, 61 | 0, 1, 1), byrow = TRUE, ncol = 3) 62 | 63 | # plot it 64 | recolorize::plotColorPalette(ctrs) 65 | 66 | # create a pixel matrix of random colors 67 | pixel_matrix <- matrix(runif(3000), ncol = 3) 68 | 69 | # assign pixels 70 | # see `assignPixels` function for details 71 | reassigned <- assignPixels(ctrs, pixel_matrix, adjust_centers = TRUE) 72 | 73 | # find residuals from original color centers 74 | color_residuals <- colorResiduals(pixel_matrix = pixel_matrix, 75 | pixel_assignments = reassigned$pixel_assignments, 76 | centers = ctrs) 77 | 78 | # compare to residuals from adjusted color centers 79 | color_residuals_adjust <- colorResiduals(pixel_matrix = pixel_matrix, 80 | pixel_assignments = reassigned$pixel_assignments, 81 | centers = reassigned$centers) 82 | # to reset graphical parameters: 83 | current_par <- graphics::par(no.readonly = TRUE) 84 | 85 | layout(matrix(1:2, nrow = 2)) 86 | hist(color_residuals$sq_residuals, 87 | breaks = 30, border = NA, col = "tomato", 88 | xlim = c(0, 1), xlab = "Squared residual", 89 | main = "Original centers") 90 | 91 | hist(color_residuals_adjust$sq_residuals, 92 | breaks = 30, border = NA, col = "cornflowerblue", 93 | xlim = c(0, 1), xlab = "Squared residual", 94 | main = "Adjusted centers") 95 | 96 | graphics::par(current_par) 97 | } 98 | -------------------------------------------------------------------------------- /man/hclust_color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/hclust_color.R 3 | \name{hclust_color} 4 | \alias{hclust_color} 5 | \title{Plot and group colors by similarity} 6 | \usage{ 7 | hclust_color( 8 | rgb_centers, 9 | dist_method = "euclidean", 10 | hclust_method = "complete", 11 | channels = 1:3, 12 | color_space = "Lab", 13 | ref_white = "D65", 14 | cutoff = NULL, 15 | n_final = NULL, 16 | return_list = TRUE, 17 | plotting = TRUE 18 | ) 19 | } 20 | \arguments{ 21 | \item{rgb_centers}{A matrix of RGB centers. Rows are centers and columns 22 | are R, G, and B values.} 23 | 24 | \item{dist_method}{Method passed to \link[stats:dist]{stats::dist}. One of "euclidean", 25 | "maximum", "manhattan", "canberra", "binary" or "minkowski".} 26 | 27 | \item{hclust_method}{Method passed to \link[stats:hclust]{stats::hclust}. One of "ward.D", 28 | "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), 29 | "median" (= WPGMC) or "centroid" (= UPGMC).} 30 | 31 | \item{channels}{Numeric: which color channels to use for clustering. Probably 32 | some combination of 1, 2, and 3, e.g., to consider only luminance and 33 | blue-yellow (b-channel) distance in CIE Lab space, \verb{channels = c(1, 3} (L 34 | and b).} 35 | 36 | \item{color_space}{Color space in which to do the clustering.} 37 | 38 | \item{ref_white}{Reference white for converting to different color spaces. 39 | D65 (the default) corresponds to standard daylight. See 40 | \link[grDevices:convertColor]{grDevices::convertColor}.} 41 | 42 | \item{cutoff}{Either \code{NULL} or a numeric cutoff passed to \link[stats:cutree]{stats::cutree}. 43 | Distance below which to combine clusters, i.e. height at which the tree 44 | should be cut.} 45 | 46 | \item{n_final}{Numeric. Desired number of groups. Overrides \code{cutoff} if 47 | both are provided.} 48 | 49 | \item{return_list}{Logical. Return a list of new group assignments from 50 | the \code{cutoff} or \code{n_final} values?} 51 | 52 | \item{plotting}{Logical. Plot a colored dendrogram?} 53 | } 54 | \value{ 55 | A list of group assignments (i.e. which centers belong to which 56 | groups), if \code{return_list = TRUE}. 57 | } 58 | \description{ 59 | A wrapper for \link[stats:hclust]{stats::hclust} for clustering colors by similarity. 60 | This works by converting a matrix of RGB centers to a given color space 61 | (CIE Lab is the default), generating a distance matrix for those colors 62 | in that color space (or a subset of channels of that color space), 63 | clustering them, and plotting them with labels and colors. If either a 64 | cutoff or a final number of colors is provided and \code{return_list = TRUE}, 65 | function also returns a list of which color centers to combine. 66 | } 67 | \details{ 68 | This is mostly useful in deciding where and in which color space 69 | to place a cutoff for a \code{recolorize} object, since it is very fast. It 70 | is called by \link{recluster} when combining layers by similarity. 71 | } 72 | \examples{ 73 | 74 | # 50 random RGB colors 75 | rgb_random <- matrix(runif(150), nrow = 50, ncol = 3) 76 | 77 | # default clustering (Lab space): 78 | hclust_color(rgb_random, return_list = FALSE) 79 | 80 | # clustering in RGB space (note change in Y-axis scale): 81 | hclust_color(rgb_random, color_space = "sRGB", return_list = FALSE) 82 | 83 | # clustering using only luminance: 84 | hclust_color(rgb_random, channels = 1, return_list = FALSE) 85 | 86 | # or only red-green ('a' channel): 87 | hclust_color(rgb_random, channels = 2, return_list = FALSE) 88 | 89 | # or only blue-yellow ('b' channel(: 90 | hclust_color(rgb_random, channels = 3, return_list = FALSE) 91 | 92 | # use a cutoff to get groups: 93 | groups <- hclust_color(rgb_random, cutoff = 100) 94 | print(groups) 95 | 96 | } 97 | \seealso{ 98 | \link{recluster} 99 | } 100 | -------------------------------------------------------------------------------- /man/imDist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/imDist.R 3 | \name{imDist} 4 | \alias{imDist} 5 | \title{Calculates the distance between non-transparent pixels in images} 6 | \usage{ 7 | imDist( 8 | im1, 9 | im2, 10 | color_space = c("Lab", "sRGB", "XYZ", "Luv"), 11 | ref_white = "D65", 12 | metric = "euclidean", 13 | plotting = TRUE, 14 | palette = "default", 15 | main = "", 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{im1, im2}{Images to compare; must have the same dimensions. Distances 21 | will be calculated between each pair of non-transparent pixels.} 22 | 23 | \item{color_space}{Color space in which to calculate distances. One of 24 | "sRGB", "Lab", "Luv", or "XYZ". Passed to 25 | \code{\link[grDevices:convertColor]{grDevices::convertColor()}}.} 26 | 27 | \item{ref_white}{Passed to \code{\link[grDevices:convertColor]{grDevices::convertColor()}} if 28 | \verb{color_space = "Lab}. Reference white for CIE Lab space.} 29 | 30 | \item{metric}{Distance metric to be used for calculating pairwise pixel 31 | distances in the given color space; passed to \code{\link[stats:dist]{stats::dist()}}.} 32 | 33 | \item{plotting}{Logical. Plot heatmap of color distances?} 34 | 35 | \item{palette}{If plotting, the color palette to be used. Default is blue to 36 | red (\code{colorRamps::blue2red(100)}).} 37 | 38 | \item{main}{Plot title.} 39 | 40 | \item{...}{Parameters passed to \code{\link[graphics:image]{graphics::image()}}.} 41 | } 42 | \value{ 43 | A matrix of the same dimensions as the original images, 44 | with the distance between non-transparent pixels at each pixel coordinate. 45 | Transparent pixels are returned as \code{NA}. 46 | } 47 | \description{ 48 | Compares two versions of the same image (probably original and recolored) 49 | by calculating the color distance between the colors of each pair of pixels. 50 | } 51 | \examples{ 52 | fulgidissima <- system.file("extdata/fulgidissima.png", 53 | package = "recolorize") 54 | fulgidissima <- png::readPNG(fulgidissima) 55 | # make an initial histogram fit 56 | # this doesn't look great: 57 | fulgidissima_2bin <- recolorize(fulgidissima, "hist", bins = 2) 58 | 59 | # we can compare with the original image by creating the recolored 60 | # image from the colormap 61 | recolored_2bin <- constructImage(fulgidissima_2bin$pixel_assignments, 62 | fulgidissima_2bin$centers) 63 | dist_2bin <- imDist(im1 = fulgidissima, 64 | im2 = recolored_2bin) 65 | 66 | # using 3 bins/channel looks much better: 67 | fulgidissima_3bin <- recolorize(fulgidissima, "hist", bins = 3) 68 | 69 | # and we can see that on the heatmap: 70 | recolored_3bin <- constructImage(fulgidissima_3bin$pixel_assignments, 71 | fulgidissima_3bin$centers) 72 | dist_3bin <- imDist(im1 = fulgidissima, 73 | im2 = recolored_3bin) 74 | 75 | # default behavior is to set the color range to the range of distances 76 | # in a single matrix; to compare two different fits, we have to provide 77 | # the same `zlim` scale for both 78 | r <- range(c(dist_2bin, dist_3bin), na.rm = TRUE) 79 | 80 | # to reset graphical parameters: 81 | current_par <- graphics::par(no.readonly = TRUE) 82 | 83 | # now we can plot them to compare the fits: 84 | layout(matrix(1:2, nrow = 1)) 85 | imHeatmap(dist_2bin, range = r) 86 | imHeatmap(dist_3bin, range = r) 87 | 88 | # we can also use other color spaces: 89 | rgb_3bin <- imDist(fulgidissima, 90 | recolored_3bin, 91 | color_space = "sRGB") 92 | 93 | # looks oddly worse, but to keep things in perspective, 94 | # you can set the range to the maximum color distance in RGB space: 95 | imHeatmap(rgb_3bin, range = c(0, sqrt(3))) 96 | # not useful for troubleshooting, but broadly reassuring! 97 | 98 | # reset: 99 | graphics::par(current_par) 100 | } 101 | -------------------------------------------------------------------------------- /man/colorClusters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colorClusters.R 3 | \name{colorClusters} 4 | \alias{colorClusters} 5 | \title{Generate color clusters from an image} 6 | \usage{ 7 | colorClusters( 8 | bg_indexed, 9 | method = c("histogram", "kmeans"), 10 | n = 10, 11 | bins = 3, 12 | color_space = "Lab", 13 | ref_white = "D65", 14 | bin_avg = TRUE 15 | ) 16 | } 17 | \arguments{ 18 | \item{bg_indexed}{A list returned by \code{\link[=backgroundIndex]{backgroundIndex()}}.} 19 | 20 | \item{method}{Binning scheme to use, one of either \code{kmeans} or \code{histogram}. 21 | Produce very different results (see details).} 22 | 23 | \item{n}{If \code{method = "kmeans"}, the number of colors to fit.} 24 | 25 | \item{bins}{If \code{method = "histogram"}, either the number of bins per color 26 | channel (if a single number is provided) OR a vector of length 3 with the 27 | number of bins for each channel.} 28 | 29 | \item{color_space}{Color space in which to cluster colors, passed to 30 | \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", or "Luv". 31 | Default is "Lab", a perceptually uniform (for humans) color space.} 32 | 33 | \item{ref_white}{Reference white for converting to different color spaces. 34 | D65 (the default) corresponds to standard daylight.} 35 | 36 | \item{bin_avg}{Logical. Return the color centers as the average of the pixels 37 | assigned to the bin (the default), or the geometric center of the bin?} 38 | } 39 | \value{ 40 | A list with the following elements: 41 | \enumerate{ 42 | \item \code{pixel_assignments}: A vector of color center assignments for 43 | each pixel. 44 | \item \code{centers}: A matrix of color centers, in RGB color space. 45 | \item \code{sizes}: The number of pixels assigned to each cluster. 46 | } 47 | } 48 | \description{ 49 | Clusters all the pixels in an image according to the specified method and 50 | returns color centers, cluster assignments, and cluster sizes. 51 | } 52 | \details{ 53 | \code{\link[stats:kmeans]{stats::kmeans()}} clustering tries to find the set of \code{n} clusters 54 | that minimize overall distances. Histogram binning divides up color space 55 | according to set breaks; for example, bins = 2 would divide the red, green, 56 | and blue channels into 2 bins each (> 0.5 and < 0 .5), resulting in 8 57 | possible ranges. A white pixel (RGB = 1, 1, 1) would fall into the R \> 0.5, G 58 | \> 0.5, B \> 0.5 bin. The resulting centers represent the average color of all 59 | the pixels assigned to that bin. 60 | 61 | K-means clustering can produce more intuitive results, but because it is 62 | iterative, it will find slightly different clusters each time it is run, and 63 | their order will be arbitrary. It also tends to divide up similar colors that 64 | make up the majority of the image. Histogram binning will produce the same 65 | results every time, in the same order, and because it forces the bins to be 66 | dispersed throughout color space, tends to better pick up small color 67 | details. Bins are also comparable across images. However, this sometimes 68 | means returning empty bins (i.e. the white bin will be empty if clustering a 69 | very dark image). 70 | } 71 | \examples{ 72 | 73 | # make a 100x100 'image' of random colors 74 | img <- array(runif(30000), dim = c(100, 100, 3)) 75 | plotImageArray(img) 76 | 77 | # make a background index object: 78 | bg_indexed <- backgroundIndex(img, backgroundCondition()) 79 | 80 | # histogram clustering 81 | hist_clusters <- colorClusters(bg_indexed, method = "hist", bins = 2) 82 | plotColorPalette(hist_clusters$centers) 83 | 84 | # we can use a different number of bins for each channel 85 | uneven_clusters <- colorClusters(bg_indexed, method = "hist", 86 | bins = c(3, 2, 1)) 87 | plotColorPalette(uneven_clusters$centers) 88 | 89 | # using kmeans 90 | kmeans_clusters <- colorClusters(bg_indexed, method = "kmeans", 91 | n = 5) 92 | plotColorPalette(kmeans_clusters$centers) 93 | 94 | } 95 | -------------------------------------------------------------------------------- /man/editLayer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/editLayers.R 3 | \name{editLayer} 4 | \alias{editLayer} 5 | \title{Edit a color patch using morphological operations} 6 | \usage{ 7 | editLayer( 8 | recolorize_obj, 9 | layer_idx, 10 | operation = "clean", 11 | px_size = 2, 12 | plotting = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{recolorize_obj}{A recolorize object from \code{\link[=recolorize]{recolorize()}}, 17 | \code{\link[=recluster]{recluster()}}, or \code{\link[=imposeColors]{imposeColors()}}.} 18 | 19 | \item{layer_idx}{A single index value (numeric) indicating which 20 | layer to edit. Corresponds to the order of the colors in the \code{centers} 21 | attribute of the recolorize object, and to the indices in the 22 | \code{pixel_assignments} attribute of the same.} 23 | 24 | \item{operation}{The name of an imager morphological operation to perform on 25 | the layer, passed as a string. See details.} 26 | 27 | \item{px_size}{The size (in pixels) of the elements to filter. If 28 | \code{operation = "shrink"} and \code{px_size = 2}, for example, the color 29 | patch will be shrunk by a 2-pixel radius.} 30 | 31 | \item{plotting}{Logical. Plot results?} 32 | } 33 | \value{ 34 | A \code{recolorize} object. The \code{sizes}, \verb{pixel_assignments,}, and 35 | \code{recolored_img} attributes will differ from the input object for the 36 | relevant color patch (layer) to reflect the edited layer. 37 | } 38 | \description{ 39 | Applies one of several morphological operations from \code{imager} to a layer of a 40 | recolorize object. Convenient for cleaning up a color patch without affecting 41 | other layers of the recolorized image. This can be used to despeckle, fill in 42 | holes, or uniformly grow or shrink a color patch. 43 | } 44 | \details{ 45 | Current imager operations are: 46 | \itemize{ 47 | \item \code{\link[imager:grow]{imager::grow()}}: Grow a pixset 48 | \item \code{\link[imager:grow]{imager::shrink()}}: Shrink a pixset 49 | \item \code{\link[imager:clean]{imager::fill()}}: Remove holes in an pixset. Accomplished by 50 | growing and then shrinking a pixset. 51 | \item \code{\link[imager:clean]{imager::clean()}}: Remove small isolated elements (speckle). 52 | Accomplished by shrinking and then growing a pixset. 53 | } 54 | } 55 | \examples{ 56 | # load image and recolorize it 57 | img <- system.file("extdata/corbetti.png", package = "recolorize") 58 | 59 | # first do a standard color binning 60 | init_fit <- recolorize(img, bins = 2, plotting = FALSE) 61 | 62 | # then cluster patches by similarity 63 | re_fit <- recluster(init_fit, cutoff = 40) 64 | 65 | # to reset graphical parameters: 66 | current_par <- graphics::par(no.readonly = TRUE) 67 | 68 | # examine individual layers: 69 | layout(matrix(1:6, nrow = 2)) 70 | layers <- splitByColor(re_fit, plot_method = "color") 71 | 72 | # notice patch 2 (cream) - lots of stray pixels 73 | edit_cream_layer <- editLayer(re_fit, 74 | layer_idx = 2, 75 | operation = "clean", 76 | px_size = 3) 77 | 78 | # shrinking and growing by the same element size gives us less flexibility, so 79 | # we can also shrink and then grow, using different px_size arguments: 80 | edit_green_1 <- editLayer(re_fit, 81 | layer_idx = 4, 82 | operation = "shrink", 83 | px_size = 2) 84 | edit_green_2 <- editLayer(edit_green_1, 85 | layer_idx = 4, 86 | operation = "grow", 87 | px_size = 3) 88 | 89 | # we can get pleasingly mondrian about it: 90 | new_fit <- re_fit 91 | for (i in 1:nrow(new_fit$centers)) { 92 | new_fit <- editLayer(new_fit, 93 | layer_idx = i, 94 | operation = "fill", 95 | px_size = 5, plotting = FALSE) 96 | } 97 | plot(new_fit) 98 | 99 | graphics::par(current_par) 100 | 101 | } 102 | \seealso{ 103 | \link{editLayers} for editing multiple layers (with multiple operations) 104 | at once; a wrapper for this function. 105 | } 106 | -------------------------------------------------------------------------------- /vignettes/step01_loading.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Step 1: Loading & processing images" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Step 1: Loading & processing images} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.align = "center", 15 | fig.width = 6, 16 | strip.white = TRUE 17 | ) 18 | ``` 19 | 20 | ```{r, echo=F} 21 | library(recolorize) 22 | current_par <- graphics::par(no.readonly = TRUE) 23 | ``` 24 | 25 | > How to get images into R. 26 | 27 | * [Introduction](Introduction.html) 28 | * [Step 0: Image acquisition and preparation](step00_prep.html) 29 | * Step 1: Loading & processing images 30 | * [Step 2: Initial clustering](step02_initial_cluster.html) 31 | * [Step 3: Refinement](step03_refinement.html) 32 | * [Step 4: Tweaks & edits](step04_manual_tweak.html) 33 | * [Step 5: Visualizing & exporting output](step05_visualization_export.html) 34 | 35 | > You can also tour the functions in the [function gallery](https://hiweller.rbind.io/post/function-gallery-for-recolorize/). 36 | 37 | Most of the actual `recolorize` functions can take a path to an image directly as input, so these steps are entirely optional. I include it here to show the option of loading the image into R first to do some basic manipulations, and because it can be useful to understand how images are structured as arrays in R. 38 | 39 | ## Reading an image into R 40 | 41 | We can read in an image by passing the filepath to the `readImage` function. This is a pretty generic function (almost every image processing package in R has something similar); the `recolorize` version doesn't even assign the output to a special class (so don't try to print it). 42 | 43 | ```{r setup} 44 | library(recolorize) 45 | 46 | # define image path - we're using an image that comes with the package 47 | img_path <- system.file("extdata/corbetti.png", package = "recolorize") 48 | 49 | # load image 50 | img <- readImage(img_path, resize = NULL, rotate = NULL) 51 | 52 | # it's just an array with 4 channels: 53 | dim(img) 54 | ``` 55 | 56 | An image is a numeric array with either 3 or 4 channels (R, G, B, and optionally alpha for transparency). JPG images will only have 3 channels; PNG images will have 4. This is quite a small image (243x116 pixels) with 4 channels. 57 | 58 | We can plot the whole array as an image, or plot one channel at a time. Notice that the red patches are bright in the R channel, same for blue-B channel, green-G channel, etc—and that the off-white patch is bright for all channels, while the black patches are dark in all channels. The alpha channel is essentially just a mask that tells us which parts of the image to ignore when processing it further. 59 | 60 | ```{r} 61 | layout(matrix(1:5, nrow = 1)) 62 | par(mar = c(0, 0, 2, 0)) 63 | plotImageArray(img, main = "RGB image") 64 | plotImageArray(img[ , , 1], main = "R channel") 65 | plotImageArray(img[ , , 2], main = "G channel") 66 | plotImageArray(img[ , , 3], main = "B channel") 67 | plotImageArray(img[ , , 4], main = "Alpha channel") 68 | ``` 69 | 70 | Optionally, when you load the image, you can resize it (highly recommended for large images) and rotate it. Image processing is computationally intensive, and R is not especially good at it, so downsampling it usually a good idea. A good rule of thumb for downsampling is that you want the smallest details you care about in the image (say, spots on a ladybug) to be about 5 pixels in diameter (so if your spots have a 20 pixel diameter, you can set `resize = 0.25`). 71 | 72 | The only other thing you might do to your images before sending them to the main `recolorize` functions is `blurImage`. This is really useful for minimizing color variation due to texture (e.g. scales on a lizard, feathers on a bird, sensory hairs on an insect), and you can apply one of several smoothing algorithms from the `imager` package, including edge-preserving blurs: 73 | 74 | ```{r} 75 | blurred_img <- blurImage(img, blur_function = "blur_anisotropic", 76 | amplitude = 10, sharpness = 0.2) 77 | ``` 78 | 79 | This step is optional: most of the `recolorize` functions will accept a path to an image as well as an image array. 80 | 81 | 82 | ```{r, echo=F} 83 | graphics::par(current_par) 84 | ``` 85 | 86 | -------------------------------------------------------------------------------- /man/recolorize2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorize2.R 3 | \name{recolorize2} 4 | \alias{recolorize2} 5 | \title{Recolorize with automatic thresholding} 6 | \usage{ 7 | recolorize2( 8 | img, 9 | method = "histogram", 10 | bins = 2, 11 | n = 5, 12 | cutoff = 20, 13 | channels = 1:3, 14 | n_final = NULL, 15 | color_space = "sRGB", 16 | recluster_color_space = "Lab", 17 | refit_method = "impose", 18 | ref_white = "D65", 19 | lower = NULL, 20 | upper = NULL, 21 | transparent = TRUE, 22 | resize = NULL, 23 | rotate = NULL, 24 | plotting = TRUE 25 | ) 26 | } 27 | \arguments{ 28 | \item{img}{Path to the image (a character vector) or a 3D image array as read 29 | in by \code{\link[png:readPNG]{png::readPNG()}} \code{{readImage}}.} 30 | 31 | \item{method}{Method for clustering image colors. One of either \code{histogram} 32 | or \code{kmeans}. See details.} 33 | 34 | \item{bins}{If \code{method = "histogram"}, either the number of bins per color 35 | channel (if a single number is provided) OR a vector of length 3 with the 36 | number of bins for each channel.} 37 | 38 | \item{n}{If \code{method = "kmeans"}, the number of color clusters to fit.} 39 | 40 | \item{cutoff}{Numeric similarity cutoff for grouping color centers 41 | together. The range is in absolute Euclidean distance. In CIE Lab space, 42 | it is greater than 0-100, but cutoff values between 20 and 80 43 | will usually work best. In RGB space, range is 0-sqrt(3). 44 | See \link{recluster} details.} 45 | 46 | \item{channels}{Numeric: which color channels to use for clustering. 47 | Probably some combination of 1, 2, and 3, e.g., to consider only luminance 48 | and blue-yellow (b-channel) distance in CIE Lab space, channels = c(1, 3 49 | (L and b).} 50 | 51 | \item{n_final}{Final number of desired colors; alternative to specifying 52 | a similarity cutoff. Overrides \code{similarity_cutoff} if provided.} 53 | 54 | \item{color_space}{Color space in which to minimize distances, passed to 55 | \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", or "Luv". 56 | Default is "sRGB".} 57 | 58 | \item{recluster_color_space}{Color space in which to group colors for 59 | reclustering. Default is CIE Lab.} 60 | 61 | \item{refit_method}{Method for refitting the image with the new color 62 | centers. One of either "impose" or "merge". \code{\link[=imposeColors]{imposeColors()}} 63 | refits the original image using the new colors (slow but often better 64 | results). \code{\link[=mergeLayers]{mergeLayers()}} merges the layers of the existing 65 | recolored image. This is faster since it doesn't require a new fit, but can 66 | produce messier results.} 67 | 68 | \item{ref_white}{Reference white for converting to different color spaces. 69 | D65 (the default) corresponds to standard daylight.} 70 | 71 | \item{lower, upper}{RGB triplet ranges for setting a bounding box of pixels to 72 | mask. See details.} 73 | 74 | \item{transparent}{Logical. Treat transparent pixels as background? Requires 75 | an alpha channel (PNG).} 76 | 77 | \item{resize}{A value between 0 and 1 for resizing the image (ex. \code{resize = 0.5} will reduce image size by 50\%). Recommended for large images as it can 78 | speed up analysis considerably. See details.} 79 | 80 | \item{rotate}{Degrees to rotate the image clockwise.} 81 | 82 | \item{plotting}{Logical. Plot final results?} 83 | } 84 | \value{ 85 | An object of S3 class \code{recolorize} with the following attributes: 86 | \enumerate{ 87 | \item \code{original_img}: The original image, as a raster array. 88 | \item \code{centers}: A matrix of color centers in RGB (0-1 range). 89 | \item \code{sizes}: The number of pixels assigned to each color cluster. 90 | \item \code{pixel_assignments}: A matrix of color center assignments for each 91 | pixel. 92 | \item \code{call}: The call(s) used to generate the \code{recolorize} object. 93 | } 94 | } 95 | \description{ 96 | Calls \link{recolorize} and \link{recluster} in sequence, since these are often 97 | very effective in combination. 98 | } 99 | \examples{ 100 | # get image path 101 | img <- system.file("extdata/corbetti.png", package = "recolorize") 102 | 103 | # fit recolorize: 104 | rc <- recolorize2(img, bins = 2, cutoff = 45) 105 | 106 | } 107 | \seealso{ 108 | \link{recolorize}, \link{recluster} 109 | } 110 | -------------------------------------------------------------------------------- /man/editLayers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/editLayers.R 3 | \name{editLayers} 4 | \alias{editLayers} 5 | \title{Edit multiple color patches using morphological operations} 6 | \usage{ 7 | editLayers( 8 | recolorize_obj, 9 | layer_idx = "all", 10 | operations = "clean", 11 | px_sizes = 2, 12 | plotting = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{recolorize_obj}{A recolorize object from \code{\link[=recolorize]{recolorize()}}, 17 | \code{\link[=recluster]{recluster()}}, or \code{\link[=imposeColors]{imposeColors()}}.} 18 | 19 | \item{layer_idx}{A numeric vector of layer indices to be edited, or \code{"all"} 20 | (in which case all layers are edited). Corresponds to the order of the 21 | colors in the \code{centers} attribute of the recolorize object, and to the 22 | indices in the \code{pixel_assignments} attribute of the same.} 23 | 24 | \item{operations}{Either a single string OR a character vector of imager 25 | morphological operation(s) to perform on the specified layer(s). If this is 26 | shorter than \code{layer_idx}, it is repeated to match the length of 27 | \code{layer_idx}.} 28 | 29 | \item{px_sizes}{The size(s) (in pixels) of the elements to filter. Either a 30 | single number OR a numeric vector. If shorter than \code{layer_idx}, it is 31 | repeated to match the length of \code{layer_idx}. If \code{operation = "shrink"} and 32 | \code{px_size = 2}, for example, the color patch will be shrunk by a 2-pixel 33 | radius.} 34 | 35 | \item{plotting}{Logical. Plot results?} 36 | } 37 | \value{ 38 | A \code{recolorize} object. The \code{sizes}, \verb{pixel_assignments,}, and 39 | \code{recolored_img} attributes will differ from the input object for the 40 | relevant color patches (layers) to reflect their changes. 41 | } 42 | \description{ 43 | A wrapper for \link{editLayer}, allowing for multiple layers 44 | to be edited at once, either with the same morphological operation 45 | or specified for each layer. 46 | } 47 | \details{ 48 | Current imager operations are: 49 | \itemize{ 50 | \item \code{\link[imager:grow]{imager::grow()}}: Grow a pixset 51 | \item \code{\link[imager:grow]{imager::shrink()}}: Shrink a pixset 52 | \item \code{\link[imager:clean]{imager::fill()}}: Remove holes in an pixset. Accomplished by 53 | growing and then shrinking a pixset. 54 | \item \code{\link[imager:clean]{imager::clean()}}: Remove small isolated elements (speckle). 55 | Accomplished by shrinking and then growing a pixset. 56 | } 57 | } 58 | \examples{ 59 | # load image and recolorize it 60 | img <- system.file("extdata/corbetti.png", package = "recolorize") 61 | 62 | # first do a standard color binning 63 | init_fit <- recolorize(img, bins = 2, plotting = FALSE) 64 | 65 | # then cluster patches by similarity 66 | re_fit <- recluster(init_fit, cutoff = 40) 67 | 68 | # to reset graphical parameters: 69 | current_par <- graphics::par(no.readonly = TRUE) 70 | 71 | # examine individual layers: 72 | layout(matrix(1:6, nrow = 2)) 73 | layers <- splitByColor(re_fit, plot_method = "color") 74 | 75 | # we can clean them all using the same parameters... 76 | edited_fit <- editLayers(re_fit, layer_idx = "all", 77 | operations = "clean", 78 | px_sizes = 2, plotting = TRUE) 79 | # ...but some of those patches don't look so good 80 | 81 | # we can use different px_sizes for each layer: 82 | edited_fit_2 <- editLayers(re_fit, layer_idx = "all", 83 | operations = "clean", 84 | px_sizes = c(1, 3, 1, 85 | 2, 1, 2), 86 | plotting = TRUE) 87 | 88 | # better yet, we can fill some layers and clean others: 89 | edited_fit_3 <- editLayers(re_fit, layer_idx = "all", 90 | operations = c("fill", "clean", 91 | "fill", "fill", 92 | "fill", "clean"), 93 | px_sizes = c(2, 3, 94 | 2, 2, 95 | 4, 2)) 96 | 97 | # or you could just get weird: 98 | edited_fit_3 <- editLayers(re_fit, layer_idx = c(1:6), 99 | operations = c("fill", "clean"), 100 | px_sizes = c(10, 20)) 101 | 102 | # reset graphical parameters: 103 | graphics::par(current_par) 104 | 105 | } 106 | \seealso{ 107 | \link{editLayer} for editing a single layer at a time. 108 | } 109 | -------------------------------------------------------------------------------- /vignettes/step03_refinement.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Step 3: Refinement" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Step 3: Refinement} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.align = "center", 15 | fig.width = 4, 16 | strip.white = TRUE 17 | ) 18 | ``` 19 | 20 | ```{r, echo=F} 21 | library(recolorize) 22 | current_par <- graphics::par(no.readonly = TRUE) 23 | ``` 24 | 25 | > Using simple rules to improve the initial results. 26 | 27 | * [Introduction](Introduction.html) 28 | * [Step 0: Image acquisition and preparation](step00_prep.html) 29 | * [Step 1: Loading & processing images](step01_loading.html) 30 | * [Step 2: Initial clustering](step02_initial_cluster.html) 31 | * Step 3: Refinement 32 | * [Step 4: Tweaks & edits](step04_manual_tweak.html) 33 | * [Step 5: Visualizing & exporting output](step05_visualization_export.html) 34 | 35 | > You can also tour the functions in the [function gallery](https://hiweller.rbind.io/post/function-gallery-for-recolorize/). 36 | 37 | 38 | Once we’ve reduced an image down to a tractable number of colors, we can define simple procedures for how to combine them based on similarity. `recolorize` (currently) comes with two of these: `recluster`, which merges colors by perceived similarity, and `thresholdRecolor`, which drops minor colors. Both are simple, but surprisingly effective. They’re also built on top of some really simple functions we’ll see in a bit, so if you need to, you can build out a similar procedure tailored to your dataset—for example, combining layers based only on their brightness values, or only combining green layers. 39 | 40 | ### `recluster()` and `recolorize2()` 41 | 42 | This is the one I use the most often, and its implementation is really simple. This function calculates the Euclidean distances between all the color centers in a recolorize object, clusters them hierarchically using `hclust`, then uses a user-specified cutoff to combine the most similar colors. As with `recolorize`, you can choose your color space, and that will make a big difference. Let’s see this in action: 43 | 44 | ```{r} 45 | library(recolorize) 46 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 47 | init_fit <- recolorize(corbetti, plotting = FALSE) 48 | recluster_results <- recluster(init_fit, 49 | cutoff = 45) 50 | ``` 51 | 52 | Notice the color dendrogram: it lumped together clusters 4 & 7, clusters 3 & 5, and clusters 6 & 8, because their distance was less than 45. This is in CIE Lab space; if we use RGB space, the range of distances is 0-1: 53 | 54 | ```{r} 55 | recluster_rgb <- recluster(init_fit, color_space = "sRGB", 56 | cutoff = 0.5) 57 | ``` 58 | 59 | In this case, we get the same results, but this is always worth playing around with. Despite its simplicity, this function is highly effective at producing intuitive results. This is partly because, in only using color similarity to combine clusters, it does not penalize smaller color clusters that can still retain important details. Because of its utility (and speed), I included a wrapper function, `recolorize2`, to run `recolorize` and `recluster` sequentially in a single step: 60 | 61 | ```{r, fig.width = 5} 62 | # let's use a different image: 63 | img <- system.file("extdata/chongi.png", package = "recolorize") 64 | 65 | # this is identical to running: 66 | # fit1 <- recolorize(img, bins = 3) 67 | # fit2 <- recluster(fit1, cutoff = 50) 68 | chongi_fit <- recolorize2(img, bins = 3, cutoff = 45) 69 | ``` 70 | 71 | There’s also a lot of room for modification here: this is a pretty unsophisticated rule for combining color clusters (ignoring, for example, cluster size, proximity, geometry, and boundary strength), but it’s pretty simple to write better rules if you can think of them, because the functions that are called to implement this are also exported by the package. 72 | 73 | ### `thresholdRecolor()` 74 | 75 | An even simpler rule: drop the smallest color clusters whose cumulative sum (as a proportion of total pixels assigned) is lower than some threshold, like 5% of the image. I thought this would be too simple to be useful, but every once in a while it’s just the thing, especially if you always end up with weird spurious details. 76 | 77 | ```{r, fig.width=5} 78 | chongi_threshold <- thresholdRecolor(chongi_fit, pct = 0.1) 79 | ``` 80 | 81 | 82 | ```{r, echo=F} 83 | graphics::par(current_par) 84 | ``` 85 | -------------------------------------------------------------------------------- /R/backgroundIndex.R: -------------------------------------------------------------------------------- 1 | #' Index and remove background pixels for color clustering 2 | #' 3 | #' Largely internal function for identifying, indexing, and removing background 4 | #' pixels from an image. 5 | #' 6 | #' @param img An image array, preferably the output of [png::readPNG()], 7 | #' [jpeg::readJPEG()], or \code{link[recolorize]{readImage}}. 8 | #' @param bg_condition Background condition, output of 9 | #' [backgroundCondition()]. 10 | #' 11 | #' @return A list with the following elements: 12 | #' \enumerate{ 13 | #' \item `flattened_img`: The original image, flattened into a 2D matrix 14 | #' (rows = pixels, columns = channels). 15 | #' \item `img_dims`: Dimensions of the original image. 16 | #' \item `non_bg`: Pixels from `flattened_img` that fall outside the 17 | #' background masking conditions. Used for further color clustering and 18 | #' analysis. 19 | #' \item `idx`: 2D (row-column) indices for background pixels. 20 | #' \item `idx_flat`: Same as `idx`, but flattened to vector order. 21 | #' } 22 | #' 23 | #' @details 24 | #' This function flattens a 3-channel image into a 2D matrix before indexing and 25 | #' removing background pixels to take advantage of faster indexing procedures. 26 | #' The `idx`, `idx_flat`, and `img_dims` elements are used to reconstruct the 27 | #' original and recolored images by other functions. 28 | #' 29 | #' @examples 30 | #' # get image path and read in image 31 | #' img_path <- system.file("extdata/chongi.png", package = "recolorize") 32 | #' img <- png::readPNG(img_path) 33 | #' recolorize::plotImageArray(img) 34 | #' 35 | #' # generate a white background condition 36 | #' bg_condition <- backgroundCondition(lower = rep(0.9, 3), 37 | #' upper = rep(1, 3)) 38 | #' 39 | #' # index background pixels 40 | #' bg_indexed <- backgroundIndex(img, bg_condition) 41 | #' 42 | #' # we can reconstruct the original image from the flattened array 43 | #' img2 <- bg_indexed$flattened_img 44 | #' dim(img2) <- bg_indexed$img_dims 45 | #' 46 | #' # notice the original background color (light gray) now shows 47 | #' recolorize::plotImageArray(img2) 48 | #' 49 | #' @export 50 | backgroundIndex <- function(img, bg_condition) { 51 | 52 | # flatten it first -- faster indexing! 53 | img_dims <- dim(img) 54 | flattened_img <- img 55 | dim(flattened_img) <- c(img_dims[1] * img_dims[2], 56 | img_dims[3]) 57 | 58 | # mask according to background condition 59 | if (inherits(bg_condition, "bg_rect")) { 60 | 61 | lower <- bg_condition$lower 62 | upper <- bg_condition$upper 63 | idx <- which((lower[1] <= img[ , , 1] & 64 | img[ , , 1] <= upper[1]) & 65 | (lower[2] <= img[ , , 2] & 66 | img[ , , 2] <= upper[2]) & 67 | (lower[3] <= img[ , , 3] & 68 | img[ , , 3] <= upper[3])) 69 | 70 | # transparency 71 | } else if (inherits(bg_condition, "bg_t")) { 72 | 73 | # if there's no transparency, oops 74 | if (ncol(flattened_img) != 4) { 75 | 76 | warning("Image has no transparency channel; clustering all pixels") 77 | idx <- character(0) 78 | 79 | } else { 80 | 81 | # otherwise use it 82 | idx <- which(round(flattened_img[ , 4]) < 1) 83 | 84 | } 85 | 86 | } else if (inherits(bg_condition, "bg_sphere")) { 87 | 88 | stop("Center/radius masking coming soon...") 89 | 90 | } else if (inherits(bg_condition, "bg_none")) { 91 | 92 | idx <- character(0) 93 | 94 | } else { 95 | stop("bg_condition must be output from backgroundCondition()") 96 | } 97 | 98 | # remove alpha channel from flattened image (no longer required) 99 | flattened_img <- flattened_img[ , 1:3] 100 | img_dims[3] <- 3 101 | 102 | # make returnables 103 | if (length(idx) == 0) { 104 | non_bg <- flattened_img 105 | idx_flat <- idx 106 | message("No pixels satisfying masking conditions; clustering all pixels") 107 | } else { 108 | non_bg <- flattened_img[-idx, ] 109 | idx_flat <- idx 110 | idx <- arrayInd(idx_flat, .dim = dim(flattened_img)) 111 | } 112 | 113 | 114 | # set S3 class - arbitrary but useful for checking 115 | bg_index <- list(flattened_img = flattened_img, 116 | img_dims = img_dims, 117 | non_bg = non_bg[ , 1:3], 118 | idx = idx, 119 | idx_flat = idx_flat) 120 | class(bg_index) <- "bg_index" 121 | 122 | return(bg_index) 123 | } 124 | -------------------------------------------------------------------------------- /man/mergeLayers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mergeLayers.R 3 | \name{mergeLayers} 4 | \alias{mergeLayers} 5 | \title{Merge layers in a recolorized image} 6 | \usage{ 7 | mergeLayers( 8 | recolorize_obj, 9 | merge_list = NULL, 10 | color_to = "weighted average", 11 | plotting = TRUE, 12 | remove_empty_centers = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{recolorize_obj}{An object of class "recolorize", such as from 17 | \code{\link[=recolorize]{recolorize()}}, \code{\link[=recluster]{recluster()}}, or 18 | \code{\link[=imposeColors]{imposeColors()}}.} 19 | 20 | \item{merge_list}{A list of numeric vectors specifying which layers 21 | to merge. Layers not included in this list are unchanged. See examples.} 22 | 23 | \item{color_to}{Color(s) for the merged layers. See examples.} 24 | 25 | \item{plotting}{Logical. Plot the results of the layer merging next 26 | to the original color fit for comparison?} 27 | 28 | \item{remove_empty_centers}{Logical. Remove empty centers with size = 0? 29 | Retaining empty color centers can be helpful when batch processing.} 30 | } 31 | \value{ 32 | A \code{recolorize} class object with merged layers. The order of the returned 33 | layers depends on \code{merge_list}: the first layers will be any not included 34 | in the list, followed by the new merged layers. If you start with layers 35 | 1-8 and merge layers 4 & 5 and 7 & 8, the returned 5 layers will be, in 36 | order and in terms of the original layers: 1, 2, 3, 6, 4 & 5 (merged), 7 & 8 37 | (merged). This is probably easiest to see in the examples. 38 | } 39 | \description{ 40 | Merges specified layers in a recolorized image. This is a good option if you 41 | want to manually specify which layers to merge (and what color to make the 42 | resulting merged layer); it's also called on by other \code{recolorize} functions 43 | like \code{\link[=recluster]{recluster()}} to merge layers that have been identified 44 | as highly similar in color using a given distance metric. 45 | } 46 | \details{ 47 | Colors can be supplied as numeric RGB triplets (e.g. \code{c(1, 1, 1)} for 48 | white), a valid R color name (\code{"white"}), or a hex code (\verb{"#FFFFFF}). 49 | Alternatively, \code{color_to = "weighted average"} will set the merged layer to 50 | the average color of the layers being merged, weighted by their relative 51 | size. Must be either a single value or a vector the same length as 52 | \code{merge_list}. If a single color is supplied, then all merged layers 53 | will be set to that color (so this really is only useful if you're 54 | already merging those layers into a single layer). 55 | } 56 | \examples{ 57 | # image path: 58 | img <- system.file("extdata/corbetti.png", package = "recolorize") 59 | 60 | # initial fit, 8 bins: 61 | init_fit <- recolorize(img) 62 | # redundant green, red, and blue clusters 63 | 64 | # to make it easier to see, we can plot the numbered palette: 65 | plot(init_fit) 66 | 67 | # based on visual inspection, we should merge: 68 | mlist <- list(c(3, 5), 69 | c(4, 7), 70 | c(6, 8)) 71 | 72 | # we can merge with that list, leaving layers 1 & 2 intact: 73 | vis_merge <- mergeLayers(init_fit, 74 | merge_list = mlist) 75 | 76 | # we can include layers 1 & 2 as their own list elements, 77 | # leaving them intact (result is identical to above): 78 | mlist2 <- list(1, 2, 79 | c(3, 5), 80 | c(4, 7), 81 | c(6, 8)) 82 | redundant_merge <- mergeLayers(init_fit, 83 | merge_list = mlist2) 84 | 85 | # we can also swap layer order this way without actually merging layers: 86 | swap_list <- list(2, 5, 3, 4, 1) 87 | swap_layers <- mergeLayers(redundant_merge, 88 | merge_list = swap_list) 89 | 90 | # merging everything but the first layer into a single layer, 91 | # and making that merged layer orange (result looks 92 | # a bit like a milkweed bug): 93 | milkweed_impostor <- mergeLayers(init_fit, 94 | merge_list = list(c(2:8)), 95 | color_to = "orange") 96 | 97 | # we can also shuffle all the layer colors while 98 | # leaving their geometry intact: 99 | centers <- vis_merge$centers 100 | centers <- centers[sample(1:nrow(centers), nrow(centers)), ] 101 | shuffle_layers <- mergeLayers(vis_merge, 102 | merge_list = as.list(1:5), 103 | color_to = centers) 104 | # (this is not really the intended purpose of this function) 105 | 106 | } 107 | -------------------------------------------------------------------------------- /R/plotColorPalette.R: -------------------------------------------------------------------------------- 1 | #' Plot a color palette 2 | #' 3 | #' Plots a color palette as a single bar, optionally scaling each color to a 4 | #' vector of sizes. 5 | #' 6 | #' @param centers Colors to plot in palette. Accepts either a character 7 | #' vector of hex codes or an n x 3 matrix (rows = colors, columns = 8 | #' channels). Assumes RGB in 0-1 range. 9 | #' @param sizes An optional numeric vector of sizes for scaling each color. If 10 | #' no sizes are provided, colors are plotted in equal proportions. 11 | #' @param cex_text Size of the numbers displayed on each color, relative to the 12 | #' default. Passed to [graphics::barplot()]. Text is only plotted if 13 | #' `sizes = NULL`. `cex_text = 0` will remove numbering. 14 | #' @param horiz Logical. Should the palette be plotted vertically or 15 | #' horizontally? 16 | #' @param ... Additional parameters passed to [graphics::barplot()]. 17 | #' 18 | #' @return No return value; plots a rectangular color palette. 19 | #' 20 | #' @details 21 | #' `plotColorPalette` does not reorder or convert colors between color spaces, 22 | #' so users working in other colorspaces should convert to RGB before plotting. 23 | #' 24 | #' @examples 25 | #' # plot 10 random colors 26 | #' rand_colors <- matrix(runif(30), ncol = 3) 27 | #' plotColorPalette(rand_colors) 28 | #' 29 | #' # plot 10 random colors with arbitrary sizes 30 | #' sizes <- runif(10, max = 1000) 31 | #' plotColorPalette(rand_colors, sizes = sizes) 32 | #' 33 | #' # reorder to plot smallest to largest 34 | #' size_order <- order(sizes) 35 | #' plotColorPalette(rand_colors[size_order, ], 36 | #' sizes[size_order]) 37 | #' 38 | #' # plot a vector of hex colors, turn off numbering 39 | #' hex_colors <- rgb(rand_colors) 40 | #' plotColorPalette(hex_colors, cex_text = 0) 41 | #' 42 | #' @export 43 | plotColorPalette <- function(centers, sizes = NULL, 44 | cex_text = 2, horiz = TRUE, ...) { 45 | 46 | # check if hex codes 47 | if (is.vector(centers)) { 48 | if (sum(grepl("#", centers)) == length(centers)) { 49 | 50 | hex_colors <- centers 51 | 52 | } else { 53 | 54 | stop("'centers' must be either a numeric RGB matrix with colors\n 55 | as rows or a character vector of hex codes") 56 | 57 | } 58 | } else if (dim(centers)[2] != 3) { 59 | 60 | stop("'centers' must have colors as rows and RGB coordinates as columns") 61 | 62 | } else { 63 | 64 | # make color vector 65 | hex_colors <- grDevices::rgb(centers[, 1], 66 | centers[, 2], 67 | centers[, 3]) 68 | 69 | 70 | } 71 | 72 | # get HSV colors 73 | hsv_colors <- grDevices::rgb2hsv(grDevices::col2rgb(hex_colors)) 74 | 75 | # make a plot 76 | if (is.null(sizes)) { 77 | 78 | # if sizes are not included, make bars equal in size 79 | colorbar <- rep(1, length(hex_colors)) 80 | stats::setNames(colorbar, as.character(1:length(hex_colors))) 81 | 82 | # we're making the palettes in different ways, so horizontal plotting is 83 | # reversed; this makes it consistent 84 | horiz <- !horiz 85 | 86 | } else { 87 | 88 | # if so, make a fake "table" with counts 89 | # this is a bit hacky, but it does make the bars adjacent instead of stacked 90 | sizes <- sizes / sum(sizes) 91 | sizes <- round(sizes * 1000) 92 | colorbar <- unlist(sapply(1:length(sizes), 93 | function(j) rep(j, sizes[j]))) 94 | colorbar <- table(colorbar, rep("", length(colorbar))) 95 | 96 | # remove any empty values 97 | if (any(sizes == 0)) { 98 | hex_colors <- hex_colors[-which(sizes == 0)] 99 | } 100 | 101 | } 102 | 103 | 104 | # plot the colors as a uniform bar 105 | graphics::barplot(colorbar, col = hex_colors, 106 | axes = FALSE, space = 0, horiz = horiz, 107 | border = NA, axisnames = FALSE, ...) 108 | 109 | # text colors - black if the color is light, white if the color is dark 110 | text_colors <- round(hsv_colors[3, ]) + 1 111 | 112 | # make text locations 113 | if (horiz == FALSE) { 114 | text_x <- seq(0.5, length(hex_colors) - 0.5) 115 | text_y <- 0.5 116 | } else { 117 | text_y <- seq(0.5, length(hex_colors) - 0.5) 118 | text_x <- 0.5 119 | } 120 | 121 | # only plot numbers if the sizes are equal 122 | # when they're distorted by sizes it gets too wacky 123 | if (is.null(sizes) & cex_text > 0) { 124 | graphics::text(text_x, text_y, 125 | cex = cex_text, 126 | col = c("white", "black")[text_colors]) 127 | } 128 | 129 | } 130 | -------------------------------------------------------------------------------- /vignettes/step04_manual_tweak.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Step 4: Tweaks & edits" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{Step 4: Tweaks & edits} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.align = "center", 15 | fig.width = 4, 16 | strip.white = TRUE 17 | ) 18 | ``` 19 | 20 | ```{r, echo=F} 21 | library(recolorize) 22 | current_par <- graphics::par(no.readonly = TRUE) 23 | ``` 24 | 25 | > Cleaning up the details. 26 | 27 | * [Introduction](Introduction.html) 28 | * [Step 0: Image acquisition and preparation](step00_prep.html) 29 | * [Step 1: Loading & processing images](step01_loading.html) 30 | * [Step 2: Initial clustering](step02_initial_cluster.html) 31 | * [Step 3: Refinement](step03_refinement.html) 32 | * Step 4: Tweaks & edits 33 | * [Step 5: Visualizing & exporting output](step05_visualization_export.html) 34 | 35 | > You can also tour the functions in the [function gallery](https://hiweller.rbind.io/post/function-gallery-for-recolorize/). 36 | 37 | 38 | These are functions that can be called individually to address problem areas in specific images, or strung together as building blocks to do more complicated operations. We'll start with this *Chrysochroa fulgidissima* image, which looks alright with a first pass using `recolorize2`: 39 | 40 | ```{r} 41 | library(recolorize) 42 | img <- system.file("extdata/fulgidissima.png", package = "recolorize") 43 | ful_init <- recolorize2(img, bins = 3, cutoff = 60, plotting = TRUE) 44 | ``` 45 | 46 | However, the angle of the iridescent green causes part of this patch to be classified as dark brown/red (color 3), resulting in a long streak and asymmetrical speckles of this color in the center of the image. 47 | 48 | ### `absorbLayer` 49 | 50 | "Absorbs" all or part of a layer into the surrounding colors, optionally according to a size or location condition. 51 | 52 | ```{r, fig.width=5} 53 | ful_absorb <- absorbLayer(ful_init, layer_idx = 3, 54 | function(s) s <= 250, 55 | y_range = c(0, 0.8)) 56 | ``` 57 | 58 | This function is really useful, but fair warning: it can be quite slow. It works by finding the color patch with which each separate component shares the longest border and switching the component to that color, which is more sophisticated than simply switching the patch color, but requires many more calculations. If you find yourself using this a lot, it's a good idea to make sure you've downsampled your images using the `resize` argument. 59 | 60 | ### `editLayer`/`editLayers` 61 | 62 | Applies one of several morphological operations from `imager` to a layer (or layers) of a `recolorize` object. This can be used to despeckle, fill in holes, or uniformly grow or shrink a color patch. In practice, this is mostly only useful for fixing small imperfections; anything too drastic tends to alter the overall shape of the patch. 63 | 64 | ```{r, fig.width = 4} 65 | # cleans up some of the speckles in the above output 66 | ful_clean <- editLayers(ful_init, layer_idx = c(2, 5), 67 | operations = "fill", px_sizes = 3, plotting = T) 68 | ``` 69 | 70 | This function is also easy to modify. Internally, it splits the color map into individual masks using `splitByColor()` (another recolorize function), then converts those to pixsets for use in `imager` before slotting them back in with the unchanged layers. 71 | 72 | ### `mergeLayers` 73 | 74 | Sometimes, you don’t want to define fancy rules for deciding which layers to combine; you just want to combine layers. That’s what this function is for. It takes in a list of numeric vectors for layers to combine (layers in the same vector are combined; those in different list elements are kept separate). 75 | 76 | ```{r, fig.width=5} 77 | corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 78 | rc <- recolorize(corbetti, plotting = FALSE) 79 | merge_fit <- mergeLayers(rc, 80 | merge_list = list(1, 2, 81 | c(3, 5), 82 | c(4, 7), 83 | c(6, 8))) 84 | ``` 85 | 86 | You might notice this is a bit different than our `recluster` results above. That’s because internally, `recluster` actually uses `imposeColors` to refit the color map, rather than just merging layers; I have found this often produces slightly nicer results, because pixels that were on the border of one cutoff or another don’t get stranded in the wrong layer. On the other hand, `mergeLayers` is considerably faster. 87 | 88 | 89 | ```{r, echo=F} 90 | graphics::par(current_par) 91 | ``` 92 | -------------------------------------------------------------------------------- /man/recolorizeVector.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recolorizeVector.R 3 | \name{recolorizeVector} 4 | \alias{recolorizeVector} 5 | \title{Convert a recolorize object to a vector} 6 | \usage{ 7 | recolorizeVector( 8 | recolorize_obj, 9 | size_filter = 0.1, 10 | smoothness = 1, 11 | base_color = "default", 12 | plotting = FALSE, 13 | resize = 1, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{recolorize_obj}{An object of class \code{recolorize}, as generated 19 | by \link{recolorize}, \link{recolorize2}, \link{imposeColors}, or \link{wernerColor}.} 20 | 21 | \item{size_filter}{The size (as a proportion of the shortest dimension of the 22 | image) of the color patch elements to absorb before vectorizing. Small 23 | details (e.g. stray pixels) tend to look very strange after vectorizing, 24 | so removing these beforehand can improve results.} 25 | 26 | \item{smoothness}{Passed to \link[smoothr:smooth]{smoothr::smooth} using the \code{"ksmooth"} 27 | method for smoothing the jagged lines that result from converting 28 | pixel coordinates to polygon vertices. Higher values = more smoothing.} 29 | 30 | \item{base_color}{The color to use to fill in the gaps that can result from 31 | smoothing. If \code{base_color = "default"}, defaults to the darkest color 32 | in the palette. Otherwise, should be the numeric index of one of the colors 33 | in \code{recolorize_obj$centers} to use.} 34 | 35 | \item{plotting}{Logical. Plot results while computing?} 36 | 37 | \item{resize}{Proportion by which to resize the color map before turning 38 | into a polygon, e.g. \code{resize = 0.5} will reduce color map size by 50\%. 39 | Speeds up the function, but you will almost always get better results 40 | by resizing the initial image when fitting the \code{recolorize} object.} 41 | 42 | \item{...}{Plotting parameters, passed on to \link[graphics:plot.default]{graphics::plot}.} 43 | } 44 | \value{ 45 | A \code{vector_recolorize} object, which is a list with the following 46 | elements: 47 | \enumerate{ 48 | \item \code{base_layer}: The base polygon, essentially the image silhouette. 49 | \item \code{layers}: A list of \link[sp:SpatialPolygons]{sp::SpatialPolygonsDataFrame} polygons, one per 50 | color patch. 51 | \item \code{layer_colors}: The colors (as hex codes) for each polygon. 52 | \item \code{base_color}: The color (as hex code) for the base polygon. 53 | \item \code{asp}: The original image aspect ratio, important for plotting. 54 | } 55 | } 56 | \description{ 57 | Converts a \code{recolorize} color map to a set of polygons, which 58 | can be plotted at any scale without losing quality (as opposed to 59 | the pixel-based bitmap format). Requires the \code{raster}, \code{rgeos}, and 60 | \code{sp} packages to be installed. Useful for creating nice visualizations; 61 | slow on large images. It's recommended to fit a \code{recolorize} object 62 | by reducing the original image first, rather than the \code{resize} argument 63 | here, which reduces the color map itself (to mixed results). 64 | } 65 | \details{ 66 | Although vector objects will typically be smaller than \code{recolorize} objects, 67 | because they only need to specify the XY coordinates of the perimeters of 68 | each polygon, they can still be fairly large (and take a long time to 69 | calculate). Users can try a few things to speed this up: using lower 70 | smoothness values; setting \code{plotting = FALSE}; resizing the image 71 | (preferably when fitting the initial \code{recolorize} object); and 72 | reducing the complexity of the color patches using \link{absorbLayer} or 73 | \link{editLayer} (e.g. by absorbing all components < 10 pixels in size). Still, 74 | expect this function to take several minutes on even moderately sized 75 | images--it takes about 7-10 seconds for the ~200x100 pixel images in the 76 | examples! Once the function finishes running, however, plotting is 77 | quite fast, and the objects themselves are smaller than the \code{recolorize} 78 | objects. 79 | } 80 | \examples{ 81 | \donttest{ 82 | img <- system.file("extdata/corbetti.png", package = "recolorize") 83 | rc <- recolorize2(img, cutoff = 45) 84 | 85 | # to reset graphical parameters: 86 | current_par <- graphics::par(no.readonly = TRUE) 87 | 88 | # takes ~10 seconds 89 | as_vector <- recolorizeVector(rc, smoothness = 5, 90 | size_filter = 0.05) 91 | 92 | # to save as an SVG with a transparent background and 93 | # no margins (e.g. for an illustration figure): 94 | grDevices::svg("recolorize_vector.svg", 95 | height = 4, width = 2, bg = "transparent") 96 | par(mar = rep(0, 4)) 97 | plot(as_vector) 98 | dev.off() 99 | 100 | # and to avoid spamming your working directory, run this line to remove 101 | # the file we just wrote: 102 | file.remove("recolorize_vector.svg") 103 | 104 | graphics::par(current_par) 105 | } 106 | } 107 | -------------------------------------------------------------------------------- /man/absorbLayer.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/absorbLayer.R 3 | \name{absorbLayer} 4 | \alias{absorbLayer} 5 | \title{Absorb a layer into its surrounding color patches} 6 | \usage{ 7 | absorbLayer( 8 | recolorize_obj, 9 | layer_idx, 10 | size_condition = function(s) s <= Inf, 11 | x_range = c(0, 1), 12 | y_range = c(0, 1), 13 | remove_empty_layers = TRUE, 14 | plotting = TRUE 15 | ) 16 | } 17 | \arguments{ 18 | \item{recolorize_obj}{A \code{recolorize} object.} 19 | 20 | \item{layer_idx}{The numeric index of the layer to absorb.} 21 | 22 | \item{size_condition}{A condition for determining which components to absorb, 23 | written as a function. The default (\code{function(l) l <= Inf}) will affect 24 | all components, since they all have fewer than infinity pixels.} 25 | 26 | \item{x_range, y_range}{The rectangular bounding box (as proportions of the 27 | image width and length) for selecting patches. Patches with at least 28 | partial overlap are counted. Defaults (0-1) include the entire image. 29 | See details.} 30 | 31 | \item{remove_empty_layers}{Logical. If the layer is completely absorbed, 32 | remove it from the layer indices and renumber the existing patches? (Example: 33 | if you completely absorb layer 3, then layer 4 -> 3 and 5 -> 4, and so on).} 34 | 35 | \item{plotting}{Logical. Plot results?} 36 | } 37 | \value{ 38 | A \code{recolorize} object. 39 | } 40 | \description{ 41 | Absorb a layer into its surrounding color patches 42 | } 43 | \details{ 44 | This function works by splitting a layer into spatially distinct 45 | 'components' using \link[imager:split_connected]{imager::split_connected}. A contiguous region of pixels 46 | is considered a single component. Only components which satisfy 47 | both the \code{size_condition} and the location condition (specified via \code{x_range} 48 | and \code{y_range}) are absorbed, so you can be target specific regions with 49 | (ideally) a minimum of fuss. 50 | 51 | The \code{size_condition} is passed as a function which must have a logical 52 | vector output (\code{TRUE} and \code{FALSE}) when applied to a vector of sizes. 53 | Usually this will be some combination of greater and less than statements, 54 | combined with logical operators like \code{&} and \code{|}. For example, 55 | \code{size_condition = function(x) x > 100 | x < 10} would affect components of 56 | greater than 100 pixels and fewer than 10 pixels, but not those with 10-100 57 | pixels. 58 | 59 | The \code{x_range} and \code{y_range} values set the bounding box of a rectangular 60 | region as proportions of the image axes, with the origin (0, 0) in the bottom 61 | left corner. Any patch which has at least partial overlap with this bounding 62 | box will be considered to satisfy the condition. When selecting this region, 63 | it can be helpful to plot a grid on the image first to narrow down an 64 | approximate region (see examples). 65 | } 66 | \examples{ 67 | 68 | \donttest{ 69 | img <- system.file("extdata/fulgidissima.png", package = "recolorize") 70 | 71 | # get an initial fit using recolorize + recluster: 72 | fit1 <- recolorize2(img, bins = 3, cutoff = 65, plotting = FALSE) 73 | # this looks okay, but the brown patch (3) has some speckling 74 | # in the upper right elytron due to reflection, and the orange 75 | # patch (4) has the same issue 76 | 77 | # the brown patch is easier to deal with, since size thresholding alone is 78 | # sufficient; we want to leave the stripes intact, so we'll absorb components 79 | # that are 50-250 pixels OR fewer than 20 pixels (to get the tiny speckles), 80 | # leaving the eyes intact 81 | fit2 <- absorbLayer(fit1, layer_idx = 3, 82 | size_condition = function(x) x <= 250 & 83 | x >= 50 | 84 | x < 20) 85 | 86 | # what about the orange speckles? this is more difficult, because 87 | # we want to retain the border around the brown stripes, but those patches 88 | # are quite small, so size thresholding won't work 89 | 90 | # but we just want to target pixels in that one region, so we can first 91 | # determine a bounding box for it by plotting a grid: 92 | plotImageArray(constructImage(fit2$pixel_assignments, 93 | fit2$centers)) 94 | axis(1, line = 3); axis(2, line = 1) 95 | abline(v = seq(0, 1, by = 0.1), 96 | h = seq(0, 1, by = 0.1), 97 | col = grey(0.2), 98 | lty = 2) 99 | # x-axis range: 0.5-0.7 100 | # y-axis range: 0.55-0.75 101 | # let's try it: 102 | fit3 <- absorbLayer(fit2, layer_idx = 4, 103 | size_condition = function(x) x < 100, 104 | x_range = c(0.5, 0.7), 105 | y_range = c(0.55, 0.75)) 106 | # looks pretty good 107 | } 108 | } 109 | \seealso{ 110 | \link{editLayers} for editing layers using morphological operations; 111 | \link{thresholdRecolor} for re-fitting the entire image without minor colors. 112 | } 113 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # recolorize v0.2.0 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/hiweller/recolorize/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/hiweller/recolorize/actions/workflows/R-CMD-check.yaml) 9 | 10 | 11 | #### Color-based image segmentation (for people with other things to do). 12 | 13 | 14 | 15 | > Comparison of color maps produced using k-means clustering (center) 16 | > vs. `recolorize` (right). Original image credits: John E. Randall, 17 | > Nathan P. Lord, and Alison Davis-Rabosky. 18 | 19 | - **Update, Feb. 2024**: Please cite the 20 | [article](https://doi.org/10.1111/ele.14378) if 21 | you’re using this package! (Also, please read the article) 22 | - **Update, Dec. 2021**: recolorize is now [on 23 | CRAN](https://cran.r-project.org/package=recolorize)! 24 | - **Update, Sept. 2021**: A methods manuscript is in progress, but in 25 | the meantime, if you need to cite this package, please cite [this 26 | abstract](https://scholar.google.com/scholar?cluster=7568048124372269297&hl=en&oi=scholarr). 27 | 28 | ## What is this? 29 | 30 | This is a package for making color maps, which are needed (or at least 31 | useful) for a wide range of color analysis techniques. It was born out 32 | of conversations with many biologists who found, to their surprise and 33 | mine, that generating color maps were the bottleneck step in their 34 | analyses. Fully automated methods rarely work all of the time, and are 35 | difficult to modify, while fully manual methods are subjective and 36 | time-consuming. This package tries to split the difference by giving you 37 | a mix of tools that will do a pretty good job with no user input, and 38 | then allow minor manual changes like merging and filtering layers or 39 | splitting components, before exporting them to the next step of your 40 | analysis (e.g. [pavo](https://cran.r-project.org/package=pavo), 41 | [patternize](https://cran.r-project.org/package=patternize)). It’s also, 42 | for the most part, totally deterministic – no arbitrary seed-setting for 43 | repeatability. 44 | 45 | ## Quick start 46 | 47 | Install the package: 48 | 49 | ``` r 50 | # development version: 51 | install.packages("devtools") 52 | devtools::install_github("hiweller/recolorize") 53 | 54 | # OR 55 | install.packages("recolorize") # CRAN release 56 | ``` 57 | 58 | To run `recolorize` on a single image: 59 | 60 | ``` r 61 | library(recolorize) 62 | 63 | # load an image that comes with the package: 64 | img <- system.file("extdata/corbetti.png", package = "recolorize") 65 | rc <- recolorize2(img, cutoff = 45) 66 | ``` 67 | 68 | 69 | 70 | A batch processing example: 71 | 72 | ``` r 73 | # get list of all PNGs that come with the package: 74 | images <- dir(system.file("extdata", package = "recolorize"), 75 | pattern = ".png", full.names = TRUE) 76 | 77 | # for every image... 78 | for (i in 1:length(images)) { 79 | 80 | # get an initial fit with generic clustering 81 | init_fit <- recolorize2(images[i], method = "hist", bins = 2, cutoff = 25, plotting = FALSE) 82 | 83 | # drop small patches 84 | refined_fit <- thresholdRecolor(init_fit, pct = 0.01, plotting = FALSE) 85 | 86 | # store in an output variable 87 | if (i == 1) { 88 | colormap_list <- list(refined_fit) 89 | } else { 90 | colormap_list[[i]] <- refined_fit 91 | } 92 | } 93 | 94 | # compare original to recolored images: 95 | layout(matrix(1:10, nrow = 2, byrow = TRUE)) 96 | par(mar = rep(0, 4)) 97 | o <- lapply(colormap_list, function(i) plot(i$original_img)) 98 | r <- lapply(colormap_list, function(i) plotImageArray(recoloredImage(i))) 99 | ``` 100 | 101 | 102 | 103 | See [package 104 | vignettes](https://cran.r-project.org/package=recolorize/vignettes/Introduction.html) 105 | for detailed documentation. 106 | 107 | ## How does it work? 108 | 109 | Recolorize is a toolbox of automatic, semi-automatic, and manual methods 110 | that aims to give you reproducible results that work pretty well 111 | out-of-box, and which are easy to tailor to your needs. The general 112 | workflow is an initial clustering step -\> an automatic or 113 | semi-automatic reclustering step -\> optional manual refinements -\> 114 | export to another format, like an image, a set of binary masks, or 115 | another R package. 116 | 117 | ## Contact 118 | 119 | Please do email me if this is something that may be relevant for you or 120 | if you have questions. Most of the features in the package are the 121 | result of feedback, and no method should be developed in a vacuum. If 122 | you include example images in your email, my likelihood of responding 123 | goes through the roof. 124 | 125 | Email: 126 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%", 13 | message = FALSE 14 | ) 15 | ``` 16 | 17 | # recolorize v`r devtools::as.package(".")$version` 18 | 19 | 20 | [![R-CMD-check](https://github.com/hiweller/recolorize/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/hiweller/recolorize/actions/workflows/R-CMD-check.yaml) 21 | 22 | 23 | #### Color-based image segmentation (for people with other things to do). 24 | 25 | 26 | 27 | > Comparison of color maps produced using k-means clustering (center) vs. `recolorize` (right). Original image credits: John E. Randall, Nathan P. Lord, and Alison Davis-Rabosky. 28 | 29 | * **Update, Feb. 2024**: Please cite the [article](https://doi.org/10.1111/ele.14378) if you're using this package! (Also, please read the article) 30 | * **Update, Dec. 2021**: recolorize is now [on CRAN](https://cran.r-project.org/package=recolorize)! 31 | * **Update, Sept. 2021**: A methods manuscript is in progress, but in the meantime, if you need to cite this package, please cite [this abstract](https://scholar.google.com/scholar?cluster=7568048124372269297&hl=en&oi=scholarr). 32 | 33 | ## What is this? 34 | 35 | This is a package for making color maps, which are needed (or at least useful) for a wide range of color analysis techniques. It was born out of conversations with many biologists who found, to their surprise and mine, that generating color maps were the bottleneck step in their analyses. Fully automated methods rarely work all of the time, and are difficult to modify, while fully manual methods are subjective and time-consuming. This package tries to split the difference by giving you a mix of tools that will do a pretty good job with no user input, and then allow minor manual changes like merging and filtering layers or splitting components, before exporting them to the next step of your analysis (e.g. [pavo](https://cran.r-project.org/package=pavo), [patternize](https://cran.r-project.org/package=patternize)). It's also, for the most part, totally deterministic – no arbitrary seed-setting for repeatability. 36 | 37 | ## Quick start 38 | 39 | Install the package: 40 | 41 | ```{r, eval = FALSE} 42 | # development version: 43 | install.packages("devtools") 44 | devtools::install_github("hiweller/recolorize") 45 | 46 | # OR 47 | install.packages("recolorize") # CRAN release 48 | ``` 49 | 50 | To run `recolorize` on a single image: 51 | 52 | ```{r, eval=F} 53 | library(recolorize) 54 | 55 | # load an image that comes with the package: 56 | img <- system.file("extdata/corbetti.png", package = "recolorize") 57 | rc <- recolorize2(img, cutoff = 45) 58 | ``` 59 | 60 | 61 | 62 | A batch processing example: 63 | 64 | ```{r, eval=F} 65 | # get list of all PNGs that come with the package: 66 | images <- dir(system.file("extdata", package = "recolorize"), 67 | pattern = ".png", full.names = TRUE) 68 | 69 | # for every image... 70 | for (i in 1:length(images)) { 71 | 72 | # get an initial fit with generic clustering 73 | init_fit <- recolorize2(images[i], method = "hist", bins = 2, cutoff = 25, plotting = FALSE) 74 | 75 | # drop small patches 76 | refined_fit <- thresholdRecolor(init_fit, pct = 0.01, plotting = FALSE) 77 | 78 | # store in an output variable 79 | if (i == 1) { 80 | colormap_list <- list(refined_fit) 81 | } else { 82 | colormap_list[[i]] <- refined_fit 83 | } 84 | } 85 | 86 | # compare original to recolored images: 87 | layout(matrix(1:10, nrow = 2, byrow = TRUE)) 88 | par(mar = rep(0, 4)) 89 | o <- lapply(colormap_list, function(i) plot(i$original_img)) 90 | r <- lapply(colormap_list, function(i) plotImageArray(recoloredImage(i))) 91 | ``` 92 | 93 | 94 | 95 | See [package vignettes](https://cran.r-project.org/package=recolorize/vignettes/Introduction.html) for detailed documentation. 96 | 97 | ## How does it work? 98 | 99 | Recolorize is a toolbox of automatic, semi-automatic, and manual methods that aims to give you reproducible results that work pretty well out-of-box, and which are easy to tailor to your needs. The general workflow is an initial clustering step -> an automatic or semi-automatic reclustering step -> optional manual refinements -> export to another format, like an image, a set of binary masks, or another R package. 100 | 101 | ## Contact 102 | 103 | Please do email me if this is something that may be relevant for you or if you have questions. Most of the features in the package are the result of feedback, and no method should be developed in a vacuum. If you include example images in your email, my likelihood of responding goes through the roof. 104 | 105 | Email: hannahiweller@gmail.com 106 | -------------------------------------------------------------------------------- /R/recolorize2.R: -------------------------------------------------------------------------------- 1 | #' Recolorize with automatic thresholding 2 | #' 3 | #' Calls [recolorize] and [recluster] in sequence, since these are often 4 | #' very effective in combination. 5 | #' 6 | #' @param img Path to the image (a character vector) or a 3D image array as read 7 | #' in by [png::readPNG()] \code{{readImage}}. 8 | #' @param method Method for clustering image colors. One of either `histogram` 9 | #' or `kmeans`. See details. 10 | #' @param n If `method = "kmeans"`, the number of color clusters to fit. 11 | #' @param bins If `method = "histogram"`, either the number of bins per color 12 | #' channel (if a single number is provided) OR a vector of length 3 with the 13 | #' number of bins for each channel. 14 | #' @param color_space Color space in which to minimize distances, passed to 15 | #' \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", or "Luv". 16 | #' Default is "sRGB". 17 | #' @param recluster_color_space Color space in which to group colors for 18 | #' reclustering. Default is CIE Lab. 19 | #' @param cutoff Numeric similarity cutoff for grouping color centers 20 | #' together. The range is in absolute Euclidean distance. In CIE Lab space, 21 | #' it is greater than 0-100, but cutoff values between 20 and 80 22 | #' will usually work best. In RGB space, range is 0-sqrt(3). 23 | #' See [recluster] details. 24 | #' @param n_final Final number of desired colors; alternative to specifying 25 | #' a similarity cutoff. Overrides `similarity_cutoff` if provided. 26 | #' @param channels Numeric: which color channels to use for clustering. 27 | #' Probably some combination of 1, 2, and 3, e.g., to consider only luminance 28 | #' and blue-yellow (b-channel) distance in CIE Lab space, channels = c(1, 3 29 | #' (L and b). 30 | #' @param refit_method Method for refitting the image with the new color 31 | #' centers. One of either "impose" or "merge". [imposeColors()] 32 | #' refits the original image using the new colors (slow but often better 33 | #' results). [mergeLayers()] merges the layers of the existing 34 | #' recolored image. This is faster since it doesn't require a new fit, but can 35 | #' produce messier results. 36 | #' @param ref_white Reference white for converting to different color spaces. 37 | #' D65 (the default) corresponds to standard daylight. 38 | #' @param lower,upper RGB triplet ranges for setting a bounding box of pixels to 39 | #' mask. See details. 40 | #' @param transparent Logical. Treat transparent pixels as background? Requires 41 | #' an alpha channel (PNG). 42 | #' @param resize A value between 0 and 1 for resizing the image (ex. `resize = 43 | #' 0.5` will reduce image size by 50%). Recommended for large images as it can 44 | #' speed up analysis considerably. See details. 45 | #' @param rotate Degrees to rotate the image clockwise. 46 | #' @param plotting Logical. Plot final results? 47 | #' 48 | #' @return An object of S3 class `recolorize` with the following attributes: 49 | #' \enumerate{ 50 | #' \item `original_img`: The original image, as a raster array. 51 | #' \item `centers`: A matrix of color centers in RGB (0-1 range). 52 | #' \item `sizes`: The number of pixels assigned to each color cluster. 53 | #' \item `pixel_assignments`: A matrix of color center assignments for each 54 | #' pixel. 55 | #' \item `call`: The call(s) used to generate the `recolorize` object. 56 | #' } 57 | #' 58 | #' @seealso [recolorize], [recluster] 59 | #' 60 | #' @examples 61 | #' # get image path 62 | #' img <- system.file("extdata/corbetti.png", package = "recolorize") 63 | #' 64 | #' # fit recolorize: 65 | #' rc <- recolorize2(img, bins = 2, cutoff = 45) 66 | #' 67 | #' @export 68 | recolorize2 <- function(img, method = "histogram", 69 | bins = 2, n = 5, 70 | cutoff = 20, 71 | channels = 1:3, 72 | n_final = NULL, 73 | color_space = "sRGB", 74 | recluster_color_space = "Lab", 75 | refit_method = "impose", 76 | ref_white = "D65", 77 | lower = NULL, upper = NULL, 78 | transparent = TRUE, 79 | resize = NULL, rotate = NULL, 80 | plotting = TRUE) { 81 | 82 | # initial fit - don't plot yet 83 | fit1 <- recolorize(img, method = method, 84 | bins = bins, n = n, 85 | color_space = color_space, 86 | ref_white = ref_white, 87 | lower = lower, upper = upper, 88 | transparent = transparent, 89 | resize = resize, rotate = rotate, 90 | plotting = FALSE) 91 | 92 | # recluster 93 | fit2 <- recluster(fit1, color_space = recluster_color_space, 94 | ref_white = ref_white, 95 | cutoff = cutoff, channels = channels, 96 | n_final = n_final, refit_method = refit_method, 97 | plot_hclust = plotting, plot_final = plotting) 98 | fit2$call <- match.call() 99 | return(fit2) 100 | } 101 | -------------------------------------------------------------------------------- /R/assignPixels.R: -------------------------------------------------------------------------------- 1 | #' Assign a 2D matrix of pixels to specified colors 2 | #' 3 | #' @param centers Matrix of color centers (rows = colors, columns = channels). 4 | #' @param pixel_matrix Matrix of pixel colors (rows = pixels, columns = channels). 5 | #' @param color_space Color space in which to minimize distances, passed to 6 | #' \code{[grDevices]{convertColor}}. One of "sRGB", "Lab", "Luv", or 7 | #' "XYZ". Default is "Lab", a perceptually uniform (for humans) color space. 8 | #' @param ref_white Reference white for converting to different color spaces. 9 | #' D65 (the default) corresponds to standard daylight. 10 | #' @param adjust_centers Logical. Should the returned color clusters be the 11 | #' average value of the pixels assigned to that cluster? See details. 12 | #' 13 | #' @return A list of class `color_clusters`, containing: 14 | #' \enumerate{ 15 | #' \item `pixel_assignments`: The color center assignment for each pixel. 16 | #' \item `centers`: A matrix of color centers. If `adjust_centers = 17 | #' FALSE`, this will be identical to the input of `centers`. 18 | #' \item `sizes`: The number of pixels assigned to each cluster. 19 | #' } 20 | #' 21 | #' @details 22 | #' This is a largely internal function called by [recolorize::imposeColors()] 23 | #' for recoloring an image based on extrinsic colors. If `adjust_centers = TRUE`, 24 | #' then after assigning pixels to given color centers, the location of each color center 25 | #' is replaced by the average color of all the pixels assigned to that center. 26 | #' 27 | #' @examples 28 | #' 29 | #' # RGB extremes (white, black, red, green, blue, yellow, magenta, cyan) 30 | #' ctrs <- matrix(c(1, 1, 1, 31 | #' 0, 0, 0, 32 | #' 1, 0, 0, 33 | #' 0, 1, 0, 34 | #' 0, 0, 1, 35 | #' 1, 1, 0, 36 | #' 1, 0, 1, 37 | #' 0, 1, 1), byrow = TRUE, ncol = 3) 38 | #' 39 | #' # plot it 40 | #' recolorize::plotColorPalette(ctrs) 41 | #' 42 | #' # create a pixel matrix of random colors 43 | #' pixel_matrix <- matrix(runif(3000), ncol = 3) 44 | #' 45 | #' # assign pixels 46 | #' reassigned <- recolorize::assignPixels(ctrs, pixel_matrix, adjust_centers = TRUE) 47 | #' recolorize::plotColorPalette(reassigned$centers) 48 | #' 49 | #' # if we turn off adjust_centers, the colors remain the same as the inputs: 50 | #' keep.centers <- recolorize::assignPixels(ctrs, pixel_matrix, adjust_centers = FALSE) 51 | #' recolorize::plotColorPalette(keep.centers$centers) 52 | #' 53 | #' @export 54 | assignPixels <- function(centers, 55 | pixel_matrix, 56 | color_space = "Lab", 57 | ref_white = "D65", 58 | adjust_centers = TRUE) { 59 | 60 | if (color_space != "sRGB") { 61 | pm <- grDevices::convertColor(pixel_matrix, 62 | from = "sRGB", 63 | to = color_space, 64 | to.ref.white = ref_white) 65 | ctrs <- grDevices::convertColor(centers, 66 | from = "sRGB", 67 | to = color_space, 68 | to.ref.white = ref_white) 69 | } else { 70 | pm <- pixel_matrix 71 | ctrs <- centers 72 | } 73 | 74 | # if there's only one new color, then we don't have to match anything 75 | if (nrow(ctrs) == 1) { 76 | pixel_assignments <- rep(1, nrow(pm)) 77 | } else { 78 | # I'm not sure this is really as fast as it could be 79 | tmp <- sapply(1:nrow(pm), 80 | function(i) apply(ctrs, 1, 81 | function(v) sum((pm[i, ]-v)^2))) 82 | 83 | # make returnables 84 | pixel_assignments <- max.col(-t(tmp)) # find index of min distance 85 | 86 | } 87 | 88 | assignments <- table(pixel_assignments) # make a table of assigned pixels 89 | sizes <- rep(0, nrow(centers)) 90 | sizes[as.numeric(names(assignments))] <- assignments # empty clusters are 0 91 | 92 | # if specified: make new color centers based on average of assigned pixels 93 | if (adjust_centers) { 94 | 95 | for (i in 1:nrow(ctrs)) { 96 | 97 | pixel_idx <- which(pixel_assignments == i) 98 | 99 | if (length(pixel_idx) == 0) { 100 | next 101 | } else if (length(pixel_idx) == 1) { 102 | 103 | ctrs[i, ] <- pm[pixel_idx, ] 104 | 105 | } else { 106 | 107 | ctrs[i, ] <- colMeans(pm[pixel_idx, ]) 108 | 109 | } 110 | 111 | } 112 | } 113 | 114 | # and convert back to sRGB 115 | if (color_space != "sRGB") { 116 | centers <- grDevices::convertColor(ctrs, 117 | from = color_space, 118 | to = "sRGB", 119 | from.ref.white = ref_white) 120 | } 121 | 122 | color_clusters <- list(pixel_assignments = pixel_assignments, 123 | centers = centers, 124 | sizes = sizes) 125 | class(color_clusters) <- "color_clusters" 126 | return(color_clusters) 127 | 128 | } 129 | 130 | -------------------------------------------------------------------------------- /R/hclust_color.R: -------------------------------------------------------------------------------- 1 | #' Plot and group colors by similarity 2 | #' 3 | #' A wrapper for [stats::hclust] for clustering colors by similarity. 4 | #' This works by converting a matrix of RGB centers to a given color space 5 | #' (CIE Lab is the default), generating a distance matrix for those colors 6 | #' in that color space (or a subset of channels of that color space), 7 | #' clustering them, and plotting them with labels and colors. If either a 8 | #' cutoff or a final number of colors is provided and `return_list = TRUE`, 9 | #' function also returns a list of which color centers to combine. 10 | #' 11 | #' @param rgb_centers A matrix of RGB centers. Rows are centers and columns 12 | #' are R, G, and B values. 13 | #' @param dist_method Method passed to [stats::dist]. One of "euclidean", 14 | #' "maximum", "manhattan", "canberra", "binary" or "minkowski". 15 | #' @param hclust_method Method passed to [stats::hclust]. One of "ward.D", 16 | #' "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), 17 | #' "median" (= WPGMC) or "centroid" (= UPGMC). 18 | #' @param channels Numeric: which color channels to use for clustering. Probably 19 | #' some combination of 1, 2, and 3, e.g., to consider only luminance and 20 | #' blue-yellow (b-channel) distance in CIE Lab space, `channels = c(1, 3` (L 21 | #' and b). 22 | #' @param ref_white Reference white for converting to different color spaces. 23 | #' D65 (the default) corresponds to standard daylight. See 24 | #' [grDevices::convertColor]. 25 | #' @param color_space Color space in which to do the clustering. 26 | #' @param cutoff Either `NULL` or a numeric cutoff passed to [stats::cutree]. 27 | #' Distance below which to combine clusters, i.e. height at which the tree 28 | #' should be cut. 29 | #' @param n_final Numeric. Desired number of groups. Overrides `cutoff` if 30 | #' both are provided. 31 | #' @param return_list Logical. Return a list of new group assignments from 32 | #' the `cutoff` or `n_final` values? 33 | #' @param plotting Logical. Plot a colored dendrogram? 34 | #' 35 | #' @return A list of group assignments (i.e. which centers belong to which 36 | #' groups), if `return_list = TRUE`. 37 | #' 38 | #' @details This is mostly useful in deciding where and in which color space 39 | #' to place a cutoff for a `recolorize` object, since it is very fast. It 40 | #' is called by [recluster] when combining layers by similarity. 41 | #' 42 | #' @seealso [recluster] 43 | #' 44 | #' @examples 45 | #' 46 | #' # 50 random RGB colors 47 | #' rgb_random <- matrix(runif(150), nrow = 50, ncol = 3) 48 | #' 49 | #' # default clustering (Lab space): 50 | #' hclust_color(rgb_random, return_list = FALSE) 51 | #' 52 | #' # clustering in RGB space (note change in Y-axis scale): 53 | #' hclust_color(rgb_random, color_space = "sRGB", return_list = FALSE) 54 | #' 55 | #' # clustering using only luminance: 56 | #' hclust_color(rgb_random, channels = 1, return_list = FALSE) 57 | #' 58 | #' # or only red-green ('a' channel): 59 | #' hclust_color(rgb_random, channels = 2, return_list = FALSE) 60 | #' 61 | #' # or only blue-yellow ('b' channel(: 62 | #' hclust_color(rgb_random, channels = 3, return_list = FALSE) 63 | #' 64 | #' # use a cutoff to get groups: 65 | #' groups <- hclust_color(rgb_random, cutoff = 100) 66 | #' print(groups) 67 | #' 68 | #' @export 69 | hclust_color <- function(rgb_centers, 70 | dist_method = "euclidean", 71 | hclust_method = "complete", 72 | channels = 1:3, 73 | color_space = "Lab", 74 | ref_white = "D65", 75 | cutoff = NULL, 76 | n_final = NULL, 77 | return_list = TRUE, 78 | plotting = TRUE) { 79 | 80 | # convert to hex colors (for plotting) and specified color space (for 81 | # distances) 82 | hex_cols <- grDevices::rgb(rgb_centers) 83 | conv_cols <- col2col(rgb_centers, 84 | from = "sRGB", 85 | to = color_space, 86 | ref_white = ref_white) 87 | 88 | # get distance matrix 89 | d <- stats::dist(conv_cols[ , channels], method = dist_method) 90 | 91 | # get hierarchical clustering 92 | hc <- stats::hclust(d, method = hclust_method) 93 | 94 | # convert to dendrogram 95 | hcd <- stats::as.dendrogram(hc) 96 | 97 | # set colors 98 | hcd <- stats::dendrapply(hcd, function(x) labelCol(x, hex_cols, cex = 3)) 99 | 100 | if (plotting) { 101 | 102 | # reset graphical parameters when function exits: 103 | current_par <- graphics::par(no.readonly = TRUE) 104 | on.exit(graphics::par(current_par)) 105 | 106 | # plot 107 | graphics::par(mar = c(3, 4, 0, 0)) 108 | plot(hcd, xlab = "", ylab = paste(color_space, "color distance")) 109 | 110 | # plot cutoff value if provided: 111 | if (!is.null(cutoff)) { 112 | graphics::abline(h = cutoff, lty = 2, col = "red", lwd = 2) 113 | } 114 | } 115 | 116 | # get list of layers to merge 117 | if (return_list) { 118 | if (is.null(cutoff)) { cutoff <- 0 } 119 | clust_groups <- stats::cutree(hc, h = cutoff, k = n_final) 120 | merge_list <- lapply(unique(clust_groups), 121 | function(i) which(clust_groups == i)) 122 | return(merge_list) 123 | } 124 | 125 | } 126 | -------------------------------------------------------------------------------- /R/wernerColor.R: -------------------------------------------------------------------------------- 1 | # a function to...with the werner colors...whatever... 2 | #' Remap an image to Werner's nomenclature 3 | #' 4 | #' Remaps a recolorize object to the colors in Werner's Nomenclature of Colors 5 | #' by Patrick Syme (1821), one of the first attempts at an objective color 6 | #' reference in western science, notably used by Charles Darwin. 7 | #' 8 | #' @param recolorize_obj A recolorize object as returned by 9 | #' [recolorize()], [recluster()], or 10 | #' [imposeColors()]. 11 | #' @param which_img Which image to recolor; one of either "original" or 12 | #' "recolored". 13 | #' @param n_colors Number of colors to list out in plotting, in order of 14 | #' size. Ex: `n_colors = 5` will plot the 5 largest colors and their names. 15 | #' All colors are returned as a normal recolorize object regardless of 16 | #' `n_colors`; this only affects the plot. 17 | #' 18 | #' @return 19 | #' A `recolorize` object with an additional list element, `werner_names`, 20 | #' listing the Werner color names for each center. 21 | #' 22 | #' @details 23 | #' See to check out the original colors. 24 | #' 25 | #' @examples 26 | #' 27 | #' 28 | #' # get an initial fit: 29 | #' corbetti <- system.file("extdata/corbetti.png", package = "recolorize") 30 | #' recolored_corbetti <- recolorize(corbetti, plotting = FALSE) 31 | #' 32 | #' # recolor original image 33 | #' corbetti_werner <- wernerColor(recolored_corbetti, 34 | #' which_img = "original", 35 | #' n_colors = 6) 36 | #' 37 | #' # we can simplify the colors and then do it again: 38 | #' corbetti_recluster <- recluster(recolored_corbetti, 39 | #' cutoff = 45, 40 | #' plot_hclust = FALSE) 41 | #' corbetti_werner <- wernerColor(corbetti_recluster, 42 | #' which_img = "recolored") 43 | #' 44 | #' @export 45 | wernerColor <- function(recolorize_obj, 46 | which_img = c("original", "recolored"), 47 | n_colors = 5) { 48 | 49 | # re-fit either original or recolored image 50 | which_img <- match.arg(which_img) 51 | 52 | # first, convert werner colors to lab 53 | werner_rgb <- t(grDevices::col2rgb(recolorize::werner$hex)) / 255 54 | werner_lab <- grDevices::convertColor(werner_rgb, 55 | "sRGB", "Lab") 56 | # get centers 57 | centers <- recolorize_obj$centers 58 | centers <- grDevices::convertColor(centers, 59 | "sRGB", "Lab") 60 | 61 | # get distances 62 | tmp <- sapply(1:nrow(centers), 63 | function(i) apply(werner_lab, 1, 64 | function(v) sqrt(sum((centers[i, ]-v)^2)))) 65 | 66 | # find index of min distance 67 | werner_idx <- max.col(-t(tmp)) 68 | 69 | # get new colors 70 | werner_centers <- werner_rgb[werner_idx, ] 71 | 72 | # pick the image 73 | if (which_img == "original") { 74 | 75 | # make RGB array and refit 76 | img <- raster_to_array(recolorize_obj$original_img) 77 | werner_fit <- imposeColors(img, 78 | werner_centers, adjust_centers = FALSE, 79 | plotting = FALSE) 80 | 81 | } else { 82 | 83 | # we just have to swap out the centers 84 | werner_fit <- recolorize_obj 85 | werner_fit$centers <- werner_centers 86 | } 87 | 88 | 89 | # if n_colors is too big... 90 | n_colors <- min(c(n_colors, nrow(werner_fit$centers))) 91 | 92 | # text labels? 93 | idx <- order(werner_fit$sizes / sum(werner_fit$sizes), 94 | decreasing = TRUE)[1:n_colors] 95 | ctrs <- werner_fit$centers[idx, ] 96 | labels <- gsub(" ", "\n", recolorize::werner$name[werner_idx[idx]]) 97 | cols <- recolorize::werner$hex[werner_idx[idx]] 98 | 99 | # reset graphical parameters when function exits: 100 | current_par <- graphics::par(no.readonly = TRUE) 101 | on.exit(graphics::par(current_par)) 102 | 103 | # set parameters and layout 104 | graphics::par(mar = c(2, 0, 2, 0)) 105 | graphics::layout(matrix(1:3, nrow = 1), widths = c(0.2, 0.55, 0.25)) 106 | 107 | # plot the palette 108 | plotColorPalette(ctrs, cex_text = 0, 109 | horiz = FALSE) 110 | 111 | # plot the recolored image 112 | plotImageArray(recoloredImage(werner_fit)) 113 | 114 | # plot the labels 115 | graphics::plot(0:1, 0:1, ann = F, axes = F, type = "n") 116 | graphics::text(0.5, seq(0.1, 0.9, length.out = n_colors), 117 | labels = labels, 118 | col = cols, 119 | cex = 2, font = 2) 120 | 121 | # append the call 122 | werner_fit$call <- append(recolorize_obj$call, match.call()) 123 | 124 | # return the fit 125 | werner_fit$werner_names <- recolorize::werner$name[werner_idx] 126 | return(werner_fit) 127 | 128 | } 129 | 130 | #' Werner's nomenclature of colors 131 | #' 132 | #' A table of the 110 colors described in "Werner's Nomenclature of Colors", the 133 | #' 1821 color reference by Patrick Syme (building on work by Abraham Gottlob 134 | #' Werner), notably used by Charles Darwin. Colors represent the average pixel 135 | #' color of each scanned swatch. 136 | #' 137 | #' @format A data frame with 110 rows and 13 variables: 138 | #' \describe{ 139 | #' \item{index}{The color index.} 140 | #' \item{family}{The broad color category (white, red, etc).} 141 | #' \item{name}{The original color name.} 142 | #' \item{hex}{Color hex code.} 143 | #' } 144 | #' @source 145 | "werner" 146 | --------------------------------------------------------------------------------