├── .github ├── .gitignore └── workflows │ ├── test-coverage.yaml │ ├── test-with-valgrind.yaml │ └── R-CMD-check.yaml ├── .gitignore ├── data ├── dogs.rda └── papers.rda ├── .gitattributes ├── tests ├── testthat.R └── testthat │ ├── test_DCTdenoising.R │ ├── test_OCR.R │ ├── test_screened_poisson_equation.R │ ├── test_treat_color_image.R │ ├── test_piecewise_equalization.R │ ├── test_iterative_triclass_thresholding.R │ ├── setup-imagerExtra.R │ ├── test_local_adaptive_thresholding.R │ ├── test_fast_discrete_cosine_transformation.R │ ├── test_fuzzy_thresholding.R │ ├── test_simplest_color_balance.R │ ├── test_multilevel_thresholding.R │ ├── test_chan_vese_segmentation.R │ └── test_adaptive_double_plateaus_histogram_equalization.R ├── .Rbuildignore ├── TODO ├── man ├── papers.Rd ├── GetHue.Rd ├── Grayscale.Rd ├── dogs.Rd ├── imagerExtra.Rd ├── RestoreHue.Rd ├── OCR.Rd ├── DenoiseDCT.Rd ├── DCT.Rd ├── EqualizeDP.Rd ├── BalanceSimplest.Rd ├── EqualizeADP.Rd ├── SPE.Rd ├── ThresholdTriclass.Rd ├── ThresholdAdaptive.Rd ├── ThresholdFuzzy.Rd ├── EqualizePiecewise.Rd ├── SegmentCV.Rd └── ThresholdML.Rd ├── R ├── data.R ├── DCT_denoising.R ├── OCR.R ├── screened_poisson_equation.R ├── treat_color_image.R ├── simplest_color_balance.R ├── misc.R ├── fast_discrete_cosine_transoformation.R ├── piecewize_equalization.R ├── local_adaptive_thresholding.R ├── fuzzy_thresholding.R ├── RcppExports.R ├── chan_vese_segmentation.R ├── utils.R ├── iterative_triclass_thresholding.R ├── multilevel_thresholding.R └── adaptive_double_plateaus_histogram_equalization.R ├── DESCRIPTION ├── NAMESPACE ├── vignettes ├── ocr.Rmd ├── color.Rmd └── intro.Rmd ├── src ├── simplest_color_balance.cpp ├── screened_poisson_equation.cpp ├── iterative_triclass_thresholding.cpp ├── piecewise_equalization.cpp ├── fast_discrete_cosine_transoformation.cpp ├── adaptive_double_plateaus_histogram_equalization.cpp ├── chan_vese_segmentation.cpp ├── fuzzy_thresholding.cpp ├── local_adaptive_thresholding.cpp ├── multilevel_thresholding.cpp └── RcppExports.cpp └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | inst/doc 2 | *.o 3 | *.so 4 | *.dll -------------------------------------------------------------------------------- /data/dogs.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ShotaOchi/imagerExtra/HEAD/data/dogs.rda -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto eol=lf 2 | data/* binary 3 | src/* text=lf 4 | R/* text=lf -------------------------------------------------------------------------------- /data/papers.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ShotaOchi/imagerExtra/HEAD/data/papers.rda -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(imagerExtra) 3 | test_check("imagerExtra") -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | README.md 2 | TODO 3 | ^\.travis\.yml$ 4 | ^appveyor\.yml$ 5 | LICENSE 6 | ^\.github$ 7 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | * add muti-scale DCT denoising 2 | 3 | * add shape descriptor 4 | 5 | * add text detection 6 | 7 | * add cartoon-texture decomposition 8 | 9 | * employ OpenMP -------------------------------------------------------------------------------- /man/papers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{papers} 5 | \alias{papers} 6 | \title{Photograph of a paper} 7 | \format{ 8 | an image of class cimg 9 | } 10 | \usage{ 11 | papers 12 | } 13 | \description{ 14 | This photograph was filmed by Shota Ochi. 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /tests/testthat/test_DCTdenoising.R: -------------------------------------------------------------------------------- 1 | test_that("DCTdenoising", 2 | { 3 | sdn_c <- 0.1 4 | sdn_bad1 <- NA 5 | 6 | flag_bad1 <- NA 7 | 8 | expect_error(DenoiseDCT(gim_bad, sdn_c)) 9 | 10 | expect_error(DenoiseDCT(gim, sdn_bad1)) 11 | 12 | expect_error(DenoiseDCT(gim, sdn_c, flag_dct16x16 = flag_bad1)) 13 | 14 | expect_class(DenoiseDCT(gim, sdn_c), class_imager) 15 | }) -------------------------------------------------------------------------------- /tests/testthat/test_OCR.R: -------------------------------------------------------------------------------- 1 | # check assert_im_px() 2 | 3 | test_that("OCR", 4 | { 5 | if (requireNamespace("tesseract", quietly = TRUE)) 6 | { 7 | expect_error(OCR(gim_bad)) 8 | expect_error(OCR(im_bad)) 9 | expect_error(OCR(gim2pix)) 10 | expect_error(OCR(gim_badpix)) 11 | 12 | expect_error(OCR_data(gim_bad)) 13 | expect_error(OCR_data(im_bad)) 14 | expect_error(OCR_data(gim2pix)) 15 | expect_error(OCR_data(gim_badpix)) 16 | } 17 | }) 18 | -------------------------------------------------------------------------------- /tests/testthat/test_screened_poisson_equation.R: -------------------------------------------------------------------------------- 1 | test_that("screened_poisson_equation", 2 | { 3 | s_c <- 0.1 4 | s_bad1 <- NA 5 | 6 | expect_error(SPE(gim_bad, s_c)) 7 | 8 | expect_error(SPE(gim, s_bad1)) 9 | expect_class(SPE(gim, 0), class_imager) 10 | 11 | expect_error(SPE(gim, s_c, s_bad1)) 12 | expect_class(SPE(gim, s_c, 0), class_imager) 13 | 14 | expect_error(SPE(gim, s_c, range = range_bad1)) 15 | 16 | expect_class(SPE(gim, s_c), class_imager) 17 | }) -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | 2 | #' Photograph of a dog from GAHAG 3 | #' 4 | #' This photograph was downloaded from http://gahag.net/img/201603/03s/gahag-0062116383-1.jpg. 5 | #' Its size was reduced by half to speed up loading and save space. 6 | #' @format an image of class cimg 7 | #' @source \url{http://gahag.net/img/201603/03s/gahag-0062116383-1.jpg} 8 | "dogs" 9 | 10 | #' Photograph of a paper 11 | #' 12 | #' This photograph was filmed by Shota Ochi. 13 | #' @format an image of class cimg 14 | "papers" -------------------------------------------------------------------------------- /man/GetHue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/treat_color_image.R 3 | \name{GetHue} 4 | \alias{GetHue} 5 | \title{store hue of color image} 6 | \usage{ 7 | GetHue(imcol) 8 | } 9 | \arguments{ 10 | \item{imcol}{a color image of class cimg} 11 | } 12 | \value{ 13 | a color image of class cimg 14 | } 15 | \description{ 16 | store hue of color image 17 | } 18 | \examples{ 19 | GetHue(boats) 20 | } 21 | \author{ 22 | Shota Ochi 23 | } 24 | -------------------------------------------------------------------------------- /man/Grayscale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/treat_color_image.R 3 | \name{Grayscale} 4 | \alias{Grayscale} 5 | \title{compute average of RGB channels} 6 | \usage{ 7 | Grayscale(imcol) 8 | } 9 | \arguments{ 10 | \item{imcol}{a color image of class cimg} 11 | } 12 | \value{ 13 | a grayscale image of class cimg 14 | } 15 | \description{ 16 | compute average of RGB channels 17 | } 18 | \examples{ 19 | Grayscale(boats) \%>\% plot 20 | } 21 | \author{ 22 | Shota Ochi 23 | } 24 | -------------------------------------------------------------------------------- /tests/testthat/test_treat_color_image.R: -------------------------------------------------------------------------------- 1 | # check assert_imcol() 2 | 3 | test_that("treat color image", 4 | { 5 | expect_error(Grayscale(gim)) 6 | expect_error(Grayscale(im2)) 7 | expect_error(Grayscale(im_c2)) 8 | expect_error(Grayscale(im_bad)) 9 | expect_class(Grayscale(im), class_imager) 10 | 11 | expect_error(GetHue(im_bad)) 12 | expect_class(GetHue(im), class_imager) 13 | 14 | expect_error(RestoreHue(gim_bad, im)) 15 | expect_error(RestoreHue(gim, gim_bad)) 16 | expect_class(RestoreHue(gim, im), class_imager) 17 | }) 18 | -------------------------------------------------------------------------------- /man/dogs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{dogs} 5 | \alias{dogs} 6 | \title{Photograph of a dog from GAHAG} 7 | \format{ 8 | an image of class cimg 9 | } 10 | \source{ 11 | \url{http://gahag.net/img/201603/03s/gahag-0062116383-1.jpg} 12 | } 13 | \usage{ 14 | dogs 15 | } 16 | \description{ 17 | This photograph was downloaded from http://gahag.net/img/201603/03s/gahag-0062116383-1.jpg. 18 | Its size was reduced by half to speed up loading and save space. 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /man/imagerExtra.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc.R 3 | \docType{package} 4 | \name{imagerExtra} 5 | \alias{imagerExtra} 6 | \title{imagerExtra: Extra Image Processing Library Based on Imager} 7 | \description{ 8 | imagerExtra is built on imager. imager by Simon Simon Barthelme provides an interface with CImg that is a C++ library for image processing. imager makes functions of CImg accessible from R and adds many utilities for accessing and working with image data from R. 9 | imagerExtra provides advanced functions for image processing based on imager. 10 | } 11 | -------------------------------------------------------------------------------- /tests/testthat/test_piecewise_equalization.R: -------------------------------------------------------------------------------- 1 | test_that("piecewise_equalization", 2 | { 3 | N <- 100 4 | bad1 <- NA 5 | bad2 <- 0 6 | 7 | expect_error(EqualizePiecewise(gim_bad, N)) 8 | expect_error(EqualizePiecewise(gim, bad1)) 9 | expect_class(EqualizePiecewise(gim, bad2), class_imager) 10 | expect_error(EqualizePiecewise(gim, N, range = range_bad1)) 11 | expect_error(EqualizePiecewise(gim, N, smax = bad1)) 12 | expect_error(EqualizePiecewise(gim, N, smax = bad2)) 13 | expect_error(EqualizePiecewise(gim, N, smin = bad1)) 14 | expect_class(EqualizePiecewise(gim, N, smin = bad2), class_imager) 15 | expect_class(EqualizePiecewise(gim, N), class_imager) 16 | }) -------------------------------------------------------------------------------- /man/RestoreHue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/treat_color_image.R 3 | \name{RestoreHue} 4 | \alias{RestoreHue} 5 | \title{restore hue of color image} 6 | \usage{ 7 | RestoreHue(im, hueim) 8 | } 9 | \arguments{ 10 | \item{im}{a grayscale image of class cimg} 11 | 12 | \item{hueim}{a color image of class cimg} 13 | } 14 | \value{ 15 | a color image of class cimg 16 | } 17 | \description{ 18 | restore hue of color image 19 | } 20 | \examples{ 21 | g <- Grayscale(boats) 22 | hue <- GetHue(boats) 23 | layout(matrix(1:2, 1, 2)) 24 | plot(g, main = "Original") 25 | RestoreHue(g, hue) \%>\% plot(main="Resotred") 26 | } 27 | \author{ 28 | Shota Ochi 29 | } 30 | -------------------------------------------------------------------------------- /tests/testthat/test_iterative_triclass_thresholding.R: -------------------------------------------------------------------------------- 1 | test_that("Iterative Triclass Thresholding", 2 | { 3 | bad <- NA 4 | 5 | expect_error(ThresholdTriclass(gim_bad)) 6 | expect_error(ThresholdTriclass(gim_uniform)) 7 | 8 | expect_error(ThresholdTriclass(gim, stopval = bad)) 9 | 10 | expect_error(ThresholdTriclass(gim, repeatnum = bad)) 11 | expect_error(ThresholdTriclass(gim, repeatnum = 0.1)) 12 | 13 | expect_error(ThresholdTriclass(gim, returnvalue = bad)) 14 | 15 | expect_error(ThresholdTriclass(gim, intervalnumber = bad)) 16 | 17 | expect_class(ThresholdTriclass(gim), class_pixset) 18 | expect_class(ThresholdTriclass(gim, returnvalue = TRUE), "numeric") 19 | }) -------------------------------------------------------------------------------- /tests/testthat/setup-imagerExtra.R: -------------------------------------------------------------------------------- 1 | library(imagerExtra) 2 | library(checkmate) 3 | 4 | class_imager <- "cimg" 5 | class_pixset <- "pixset" 6 | 7 | notim <- 1 8 | im <- boats 9 | im2 <- imrep(im, 2) %>% imappend(., "z") 10 | gim <- grayscale(im) 11 | im_c2 <- imrep(gim, 2) %>% imappend(., "c") 12 | gim2 <- imrep(gim, 2) %>% imappend(., "z") 13 | gim_bad <- gim 14 | gim_bad[2,2] <- NA 15 | im_bad <- im 16 | im_bad[1,1,1] <- NA 17 | gim_uniform <- as.cimg(matrix(1,100,100)) 18 | 19 | impix <- boats %>% as.pixset 20 | gimpix <- gim %>% as.pixset 21 | gim2pix <- gim2 %>% as.pixset 22 | gim_badpix <- gim_bad %>% as.pixset 23 | 24 | range_bad1 <- c(1,1,1) 25 | range_bad2 <- c(-1,1) 26 | range_bad3 <- c(NA, 255) 27 | range_badorder <- c(255, 0) 28 | range_bad4 <- c(1,1) 29 | 30 | return_bad1 <- "A" 31 | return_bad2 <- -1 32 | return_bad3 <- c(0.1,0.1,0.1) 33 | return_bad4 <- NA 34 | return_bad5 <- NULL 35 | -------------------------------------------------------------------------------- /tests/testthat/test_local_adaptive_thresholding.R: -------------------------------------------------------------------------------- 1 | test_that("local adaptive thresholding", 2 | { 3 | k_c <- 0.1 4 | k_bad1 <- NA 5 | k_bad2 <- 11 6 | 7 | windowsize_bad1 <- NA 8 | windowsize_bad2 <- 2 9 | windowsize_bad3 <- 12 10 | windowsize_bad4 <- 2 * max(dim(gim)) + 1 11 | 12 | range_bad3 <- c(NA, 255) 13 | 14 | expect_error(ThresholdAdaptive(gim_bad, k_c)) 15 | 16 | expect_error(ThresholdAdaptive(gim, k_bad1)) 17 | expect_error(ThresholdAdaptive(gim, k_bad2)) 18 | 19 | expect_error(ThresholdAdaptive(gim, k_c, range = range_bad1)) 20 | expect_error(ThresholdAdaptive(gim, k_c, range = range_bad4)) 21 | 22 | expect_error(ThresholdAdaptive(gim, k_c, windowsize_bad1)) 23 | expect_error(ThresholdAdaptive(gim, k_c, windowsize_bad2)) 24 | expect_warning(ThresholdAdaptive(gim, k_c, windowsize_bad3)) 25 | expect_error(ThresholdAdaptive(gim, k_c, windowsize_bad4)) 26 | 27 | expect_class(ThresholdAdaptive(gim, k_c), class_pixset) 28 | }) 29 | -------------------------------------------------------------------------------- /man/OCR.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/OCR.R 3 | \name{OCR} 4 | \alias{OCR} 5 | \alias{OCR_data} 6 | \title{Optical Character Recognition with tesseract} 7 | \usage{ 8 | OCR(imorpx, engine = tesseract::tesseract("eng"), HOCR = FALSE) 9 | 10 | OCR_data(imorpx, engine = tesseract::tesseract("eng")) 11 | } 12 | \arguments{ 13 | \item{imorpx}{a grayscale image of class cimg, a color image of class cimg, or a pixel set} 14 | 15 | \item{engine}{a tesseract engine. See the reference manual of tesseract for detail.} 16 | 17 | \item{HOCR}{if TRUE return results as HOCR xml instead of plain text} 18 | } 19 | \description{ 20 | OCR and OCR_data are wrappers for ocr and ocr_data of tesseract package. 21 | You need to install tesseract package to use these functions. 22 | } 23 | \examples{ 24 | hello <- DenoiseDCT(papers, 0.01) \%>\% ThresholdAdaptive(., 0.1, range = c(0,1)) 25 | if (requireNamespace("tesseract", quietly = TRUE)) 26 | { 27 | OCR(hello) \%>\% cat 28 | OCR_data(hello) 29 | } 30 | } 31 | \author{ 32 | Shota Ochi 33 | } 34 | -------------------------------------------------------------------------------- /man/DenoiseDCT.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/DCT_denoising.R 3 | \name{DenoiseDCT} 4 | \alias{DenoiseDCT} 5 | \title{denoise image by DCT denoising} 6 | \usage{ 7 | DenoiseDCT(im, sdn, flag_dct16x16 = FALSE) 8 | } 9 | \arguments{ 10 | \item{im}{a grayscale image of class cimg} 11 | 12 | \item{sdn}{standard deviation of Gaussian white noise} 13 | 14 | \item{flag_dct16x16}{flag_dct16x16 determines the size of patches. if TRUE, the size of patches is 16x16. if FALSE, the size if patches is 8x8.} 15 | } 16 | \value{ 17 | a grayscale image of class cimg 18 | } 19 | \description{ 20 | denoise image by DCT denoising 21 | } 22 | \examples{ 23 | dev.new() 24 | par(mfcol = c(1,2)) 25 | boats_g <- grayscale(boats) 26 | boats_noisy <- imnoise(dim = dim(boats_g), sd = 0.05) + boats_g 27 | plot(boats_noisy, main = "Noisy Boats") 28 | DenoiseDCT(boats_g, 0.05) \%>\% plot(., main = "Denoised Boats") 29 | } 30 | \references{ 31 | Guoshen Yu, and Guillermo Sapiro, DCT Image Denoising: a Simple and Effective Image Denoising Algorithm, Image Processing On Line, 1 (2011), pp. 292-296. \doi{10.5201/ipol.2011.ys-dct} 32 | } 33 | \author{ 34 | Shota Ochi 35 | } 36 | -------------------------------------------------------------------------------- /tests/testthat/test_fast_discrete_cosine_transformation.R: -------------------------------------------------------------------------------- 1 | test_that("fast discrete cosine transformation", 2 | { 3 | mat_gim <- as.matrix(gim) 4 | mat_bad1 <- 1 5 | mat_bad2 <- NULL 6 | mat_bad3 <- matrix(NA,100,100) 7 | mat_bad4 <- matrix("A", 200,300) 8 | 9 | bad1 <- NA 10 | expect_error(DCT2D(gim_bad)) 11 | 12 | expect_error(DCT2D(mat_bad1)) 13 | expect_error(DCT2D(mat_bad2)) 14 | expect_error(DCT2D(mat_bad3)) 15 | expect_error(DCT2D(mat_bad4)) 16 | 17 | expect_error(DCT2D(gim, returnmat = bad1)) 18 | 19 | expect_equal(DCT2D(gim), DCT2D(mat_gim)) 20 | expect_equal(DCT2D(gim, returnmat = TRUE), as.matrix(DCT2D(gim))) 21 | expect_class(DCT2D(gim), class_imager) 22 | expect_class(DCT2D(gim, returnmat = TRUE), "matrix") 23 | 24 | expect_error(IDCT2D(mat_bad1)) 25 | expect_error(IDCT2D(mat_bad2)) 26 | expect_error(IDCT2D(mat_bad3)) 27 | expect_error(IDCT2D(mat_bad4)) 28 | 29 | expect_error(IDCT2D(gim, returnmat = bad1)) 30 | 31 | expect_equal(IDCT2D(gim), IDCT2D(mat_gim)) 32 | expect_equal(IDCT2D(gim, returnmat = TRUE), as.matrix(IDCT2D(gim))) 33 | expect_class(IDCT2D(gim), class_imager) 34 | expect_class(IDCT2D(gim, returnmat = TRUE), "matrix") 35 | }) -------------------------------------------------------------------------------- /R/DCT_denoising.R: -------------------------------------------------------------------------------- 1 | #' denoise image by DCT denoising 2 | #' 3 | #' @param im a grayscale image of class cimg 4 | #' @param sdn standard deviation of Gaussian white noise 5 | #' @param flag_dct16x16 flag_dct16x16 determines the size of patches. if TRUE, the size of patches is 16x16. if FALSE, the size if patches is 8x8. 6 | #' @return a grayscale image of class cimg 7 | #' @references Guoshen Yu, and Guillermo Sapiro, DCT Image Denoising: a Simple and Effective Image Denoising Algorithm, Image Processing On Line, 1 (2011), pp. 292-296. \doi{10.5201/ipol.2011.ys-dct} 8 | #' @author Shota Ochi 9 | #' @export 10 | #' @examples 11 | #' dev.new() 12 | #' par(mfcol = c(1,2)) 13 | #' boats_g <- grayscale(boats) 14 | #' boats_noisy <- imnoise(dim = dim(boats_g), sd = 0.05) + boats_g 15 | #' plot(boats_noisy, main = "Noisy Boats") 16 | #' DenoiseDCT(boats_g, 0.05) %>% plot(., main = "Denoised Boats") 17 | DenoiseDCT <- function(im, sdn, flag_dct16x16 = FALSE) 18 | { 19 | assert_im(im) 20 | assert_positive_numeric_one_elem(sdn) 21 | assert_logical_one_elem(flag_dct16x16) 22 | dim_im <- dim(im) 23 | res <- DCTdenoising(as.matrix(im), dim_im[2], dim_im[1], sdn, as.integer(!flag_dct16x16)) 24 | return(as.cimg(res)) 25 | } -------------------------------------------------------------------------------- /man/DCT.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fast_discrete_cosine_transoformation.R 3 | \name{DCT} 4 | \alias{DCT} 5 | \alias{DCT2D} 6 | \alias{IDCT2D} 7 | \title{Two Dimensional Discrete Cosine Transformation and Inverse Cosine Transformation} 8 | \usage{ 9 | DCT2D(imormat, returnmat = FALSE) 10 | 11 | IDCT2D(imormat, returnmat = FALSE) 12 | } 13 | \arguments{ 14 | \item{imormat}{a grayscale image of class cimg or a numeric matrix} 15 | 16 | \item{returnmat}{if returnmat is TRUE, returns numeric matrix. if FALSE, returns a grayscale image of class cimg.} 17 | } 18 | \value{ 19 | a grayscale image of class cimg or a numeric matrix 20 | } 21 | \description{ 22 | DCT2D computes two dimensional discrete cosine transformation. 23 | IDCT2D computes two dimensional inverse discrete cosine transformation. 24 | } 25 | \examples{ 26 | g <- grayscale(boats) 27 | layout(matrix(1:2, 1, 2)) 28 | plot(g, main = "Original") 29 | gg <- DCT2D(g) \%>\% IDCT2D() \%>\% plot(main = "Transformed") 30 | mean((g - gg)^2) 31 | } 32 | \references{ 33 | Makhoul, J. (1980). A fast cosine transform in one and two dimensions. IEEE Transactions on Acoustics, Speech, and Signal Processing. 28 (1): 27-34. 34 | } 35 | \author{ 36 | Shota Ochi 37 | } 38 | -------------------------------------------------------------------------------- /tests/testthat/test_fuzzy_thresholding.R: -------------------------------------------------------------------------------- 1 | test_that("fuzzy thresholding", 2 | { 3 | bad <- NA 4 | 5 | expect_error(ThresholdFuzzy(gim_bad)) 6 | expect_error(ThresholdFuzzy(gim_uniform)) 7 | 8 | expect_error(ThresholdFuzzy(gim, returnvalue = bad)) 9 | 10 | expect_error(ThresholdFuzzy(gim, n = bad)) 11 | expect_error(ThresholdFuzzy(gim, n = 0.1)) 12 | 13 | expect_error(ThresholdFuzzy(gim, maxiter = bad)) 14 | expect_error(ThresholdFuzzy(gim, maxiter = 1)) 15 | 16 | expect_error(ThresholdFuzzy(gim, intervalnumber = bad)) 17 | expect_error(ThresholdFuzzy(gim, intervalnumber = 1)) 18 | 19 | expect_error(ThresholdFuzzy(gim, c1 = bad)) 20 | expect_error(ThresholdFuzzy(gim, c2 = bad)) 21 | 22 | expect_error(ThresholdFuzzy(gim, mutrate = bad)) 23 | 24 | expect_error(ThresholdFuzzy(gim, vmaxcoef = bad)) 25 | 26 | expect_error(ThresholdFuzzy(gim, omegamax = bad)) 27 | expect_error(ThresholdFuzzy(gim, omegamax = 1)) 28 | 29 | expect_error(ThresholdFuzzy(gim, omegamin = bad)) 30 | expect_error(ThresholdFuzzy(gim, omegamin = 1)) 31 | 32 | expect_error(ThresholdFuzzy(gim, omegamax = 0.2, omegamin = 0.5)) 33 | 34 | expect_class(ThresholdFuzzy(gim), class_pixset) 35 | expect_class(ThresholdFuzzy(gim, returnvalue = TRUE), "numeric") 36 | }) 37 | -------------------------------------------------------------------------------- /man/EqualizeDP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in 3 | % R/adaptive_double_plateaus_histogram_equalization.R 4 | \name{EqualizeDP} 5 | \alias{EqualizeDP} 6 | \title{Double Plateaus Histogram Equalization} 7 | \usage{ 8 | EqualizeDP(im, t_down, t_up, N = 1000, range = c(0, 255)) 9 | } 10 | \arguments{ 11 | \item{im}{a grayscale image of class cimg} 12 | 13 | \item{t_down}{lower threshold} 14 | 15 | \item{t_up}{upper threshold} 16 | 17 | \item{N}{the number of subintervals of histogram} 18 | 19 | \item{range}{range of the pixel values of image. this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1].} 20 | } 21 | \value{ 22 | a grayscale image of class cimg 23 | } 24 | \description{ 25 | enhances contrast of image by double plateaus histogram equalization. 26 | } 27 | \examples{ 28 | g <- grayscale(dogs) 29 | layout(matrix(1:2, 1, 2)) 30 | plot(g, main = "Original") 31 | EqualizeDP(g, 20, 186) \%>\% plot(main = "Contrast Enhanced") 32 | } 33 | \references{ 34 | Kun Liang, Yong Ma, Yue Xie, Bo Zhou ,Rui Wang (2012). A new adaptive contrast enhancement algorithm for infrared images based on double plateaus histogram equalization. Infrared Phys. Technol. 55, 309-315. 35 | } 36 | \author{ 37 | Shota Ochi 38 | } 39 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: imagerExtra 2 | Type: Package 3 | Title: Extra Image Processing Library Based on 'imager' 4 | Version: 2.0.0 5 | Authors@R: c( 6 | person("Shota", "Ochi", email = "shotaochi1990@gmail.com", role = c("aut", "cre", "cph")), 7 | person("Guoshen", "Yu", email = "yu@cmap.polytechnique.fr", role = c("ctb", "cph")), 8 | person("Guillermo", "Sapiro", email = "guille@umn.edu", role = c("ctb", "cph")), 9 | person("Catalina", "Sbert", email = "catalina.sbert@uib.es", role = c("ctb", "cph")), 10 | person("Image Processing On Line", role = "cph"), 11 | person("Pascal", "Getreuer", email = "getreuer@gmail.com", role = c("ctb", "cph"))) 12 | Maintainer: Shota Ochi 13 | Description: Provides advanced functions for image processing based on the package 'imager'. 14 | License: GPL-3 15 | Depends: 16 | R (>= 2.10.0), 17 | imager (>= 0.40.2) 18 | Imports: 19 | checkmate, 20 | fftwtools, 21 | magrittr, 22 | Rcpp (>= 0.12.14) 23 | Suggests: 24 | knitr, 25 | rmarkdown, 26 | tesseract, 27 | testthat (>= 2.0.0) 28 | URL: https://github.com/ShotaOchi/imagerExtra 29 | BugReports: https://github.com/ShotaOchi/imagerExtra/issues 30 | LinkingTo: Rcpp 31 | LazyData: true 32 | RoxygenNote: 7.2.3 33 | VignetteBuilder: knitr 34 | Encoding: UTF-8 35 | -------------------------------------------------------------------------------- /man/BalanceSimplest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simplest_color_balance.R 3 | \name{BalanceSimplest} 4 | \alias{BalanceSimplest} 5 | \title{Balance color of image by Simplest Color Balance} 6 | \usage{ 7 | BalanceSimplest(im, sleft, sright, range = c(0, 255)) 8 | } 9 | \arguments{ 10 | \item{im}{a grayscale image of class cimg} 11 | 12 | \item{sleft}{left saturation percentage. sleft can be specified by numeric or string, e.g. 1 and "1\%". note that sleft is a percentile.} 13 | 14 | \item{sright}{right saturation percentage. sright can be specified by numeric or string. note that sright is a percentile.} 15 | 16 | \item{range}{this function assumes that the range of pixel values of of input image is [0,255] by default. you may prefer [0,1].} 17 | } 18 | \value{ 19 | a grayscale image of class cimg 20 | } 21 | \description{ 22 | Balance color of image by Simplest Color Balance 23 | } 24 | \examples{ 25 | dev.new() 26 | par(mfcol = c(1,2)) 27 | boats_g <- grayscale(boats) 28 | plot(boats_g, main = "Original") 29 | BalanceSimplest(boats_g, 1, 1) \%>\% plot(., main = "Simplest Color Balance") 30 | } 31 | \references{ 32 | Nicolas Limare, Jose-Luis Lisani, Jean-Michel Morel, Ana Belen Petro, and Catalina Sbert, Simplest Color Balance, Image Processing On Line, 1 (2011), pp. 297-315. \doi{10.5201/ipol.2011.llmps-scb} 33 | } 34 | \author{ 35 | Shota Ochi 36 | } 37 | -------------------------------------------------------------------------------- /tests/testthat/test_simplest_color_balance.R: -------------------------------------------------------------------------------- 1 | # check assert_im(), assert_range(), assert_s(), assert_s_left_right() 2 | 3 | test_that("simplest_color_balance", 4 | { 5 | s_c <- 0.1 6 | s_c2 <- "0.1%" 7 | s_bad1 <- -1 8 | s_bad2 <- 1000 9 | s_bad3_1 <- 60 10 | s_bad3_2 <- 70 11 | s_bad4 <- NULL 12 | s_bad5 <- NA 13 | s_bad6 <- "Hello" 14 | 15 | expect_error(BalanceSimplest(notim, s_c, s_c)) 16 | expect_error(BalanceSimplest(gim2, s_c, s_c)) 17 | expect_error(BalanceSimplest(im, s_c, s_c)) 18 | expect_error(BalanceSimplest(gim_bad, s_c, s_c)) 19 | 20 | expect_error(BalanceSimplest(gim, s_c, s_c, range = range_bad1)) 21 | expect_error(BalanceSimplest(gim, s_c, s_c, range = range_bad2)) 22 | expect_error(BalanceSimplest(gim, s_c, s_c, range = range_bad3)) 23 | expect_error(BalanceSimplest(gim, s_c, s_c, range = range_badorder)) 24 | 25 | expect_error(BalanceSimplest(gim, s_bad1, s_c)) 26 | expect_error(BalanceSimplest(gim, s_c, s_bad2)) 27 | expect_error(BalanceSimplest(gim, s_bad3_1, s_bad3_2)) 28 | expect_error(BalanceSimplest(gim, s_c, s_bad4)) 29 | expect_error(BalanceSimplest(gim, s_c, s_bad5)) 30 | expect_error(BalanceSimplest(gim, s_bad6, s_C)) 31 | 32 | expect_class(BalanceSimplest(gim, s_c, s_c), class_imager) 33 | expect_class(BalanceSimplest(gim, s_c2, s_c2), class_imager) 34 | expect_equal(BalanceSimplest(gim, s_c, s_c), BalanceSimplest(gim, s_c2, s_c2)) 35 | }) 36 | -------------------------------------------------------------------------------- /man/EqualizeADP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in 3 | % R/adaptive_double_plateaus_histogram_equalization.R 4 | \name{EqualizeADP} 5 | \alias{EqualizeADP} 6 | \title{Adaptive Double Plateaus Histogram Equalization} 7 | \usage{ 8 | EqualizeADP(im, n = 5, N = 1000, range = c(0, 255), returnparam = FALSE) 9 | } 10 | \arguments{ 11 | \item{im}{a grayscale image of class cimg} 12 | 13 | \item{n}{window size to determine local maximum} 14 | 15 | \item{N}{the number of subintervals of histogram} 16 | 17 | \item{range}{range of the pixel values of image. this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1].} 18 | 19 | \item{returnparam}{if returnparam is TRUE, returns the computed parameters: t_down and t_up.} 20 | } 21 | \value{ 22 | a grayscale image of class cimg or a numericvector 23 | } 24 | \description{ 25 | computes the parameters, t_down and t_up, and then apply double plateaus histogram equalization. 26 | } 27 | \examples{ 28 | g <- grayscale(dogs) 29 | layout(matrix(1:2, 1, 2)) 30 | plot(g, main = "Original") 31 | EqualizeADP(g) \%>\% plot(main = "Contrast Enhanced") 32 | } 33 | \references{ 34 | Kun Liang, Yong Ma, Yue Xie, Bo Zhou ,Rui Wang (2012). A new adaptive contrast enhancement algorithm for infrared images based on double plateaus histogram equalization. Infrared Phys. Technol. 55, 309-315. 35 | } 36 | \author{ 37 | Shota Ochi 38 | } 39 | -------------------------------------------------------------------------------- /man/SPE.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/screened_poisson_equation.R 3 | \name{SPE} 4 | \alias{SPE} 5 | \title{Correct inhomogeneous background of image by solving Screened Poisson Equation} 6 | \usage{ 7 | SPE(im, lamda, s = 0.1, range = c(0, 255)) 8 | } 9 | \arguments{ 10 | \item{im}{a grayscale image of class cimg} 11 | 12 | \item{lamda}{this function corrects inhomogeneous background while preserving image details. lamda controls the trade-off. when lamda is too large, this function acts as an edge detector.} 13 | 14 | \item{s}{saturation percentage. this function uses \code{\link{BalanceSimplest}}. s is used as both sleft and sright. that's why s can not be over 50\%.} 15 | 16 | \item{range}{this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1].} 17 | } 18 | \value{ 19 | a grayscale image of class cimg 20 | } 21 | \description{ 22 | Correct inhomogeneous background of image by solving Screened Poisson Equation 23 | } 24 | \examples{ 25 | dev.new() 26 | par(mfcol = c(1,2)) 27 | boats_g <- grayscale(boats) 28 | plot(boats_g, main = "Original") 29 | SPE(boats_g, 0.1) \%>\% plot(main = "Screened Poisson Equation") 30 | } 31 | \references{ 32 | Jean-Michel Morel, Ana-Belen Petro, and Catalina Sbert, Screened Poisson Equation for Image Contrast Enhancement, Image Processing On Line, 4 (2014), pp. 16-29. \doi{10.5201/ipol.2014.84} 33 | } 34 | \author{ 35 | Shota Ochi 36 | } 37 | -------------------------------------------------------------------------------- /man/ThresholdTriclass.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/iterative_triclass_thresholding.R 3 | \name{ThresholdTriclass} 4 | \alias{ThresholdTriclass} 5 | \title{Iterative Triclass Thresholding} 6 | \usage{ 7 | ThresholdTriclass( 8 | im, 9 | stopval = 0.01, 10 | repeatnum, 11 | intervalnumber = 1000, 12 | returnvalue = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{im}{a grayscale image of class cimg} 17 | 18 | \item{stopval}{value to determine whether stop iteration of triclass thresholding or not. Note that if repeat is set, stop is ignored.} 19 | 20 | \item{repeatnum}{number of repetition of triclass thresholding} 21 | 22 | \item{intervalnumber}{interval number of histogram} 23 | 24 | \item{returnvalue}{if returnvalue is TRUE, ThresholdTriclass returns threshold value. if FALSE, ThresholdTriclass returns pixset.} 25 | } 26 | \value{ 27 | a pixel set or a numeric 28 | } 29 | \description{ 30 | compute threshold value by Iterative Triclass Threshold Technique 31 | } 32 | \examples{ 33 | g <- grayscale(boats) 34 | layout(matrix(1:4, 2, 2)) 35 | plot(boats, main = "Original") 36 | plot(g, main = "Grayscale") 37 | threshold(g) \%>\% plot(main = "A Variant of Otsu") 38 | ThresholdTriclass(g) \%>\% plot(main = "Triclass") 39 | } 40 | \references{ 41 | Cai HM, Yang Z, Cao XH, Xia WM, Xu XY (2014). A New Iterative Triclass Thresholding Technique in Image Segmentation. IEEE TRANSACTIONS ON IMAGE PROCESSING. 42 | } 43 | \author{ 44 | Shota Ochi 45 | } 46 | -------------------------------------------------------------------------------- /R/OCR.R: -------------------------------------------------------------------------------- 1 | #' Optical Character Recognition with tesseract 2 | #' 3 | #' OCR and OCR_data are wrappers for ocr and ocr_data of tesseract package. 4 | #' You need to install tesseract package to use these functions. 5 | #' @name OCR 6 | #' @param imorpx a grayscale image of class cimg, a color image of class cimg, or a pixel set 7 | #' @param engine a tesseract engine. See the reference manual of tesseract for detail. 8 | #' @param HOCR if TRUE return results as HOCR xml instead of plain text 9 | #' @author Shota Ochi 10 | #' @examples 11 | #' hello <- DenoiseDCT(papers, 0.01) %>% ThresholdAdaptive(., 0.1, range = c(0,1)) 12 | #' if (requireNamespace("tesseract", quietly = TRUE)) 13 | #' { 14 | #' OCR(hello) %>% cat 15 | #' OCR_data(hello) 16 | #' } 17 | NULL 18 | 19 | #' @rdname OCR 20 | #' @export 21 | OCR <- function(imorpx, engine = tesseract::tesseract("eng"), HOCR=FALSE) 22 | { 23 | assert_im_px(imorpx) 24 | if (is.pixset(imorpx)) 25 | { 26 | imorpx <- as.cimg(imorpx) 27 | } 28 | tmp <- tempfile(fileext = ".png") 29 | on.exit(unlink(tmp)) 30 | imager::save.image(imorpx, tmp) 31 | tesseract::ocr(tmp, engine = engine, HOCR = HOCR) 32 | } 33 | 34 | #' @rdname OCR 35 | #' @export 36 | OCR_data <- function(imorpx, engine = tesseract::tesseract("eng")) 37 | { 38 | assert_im_px(imorpx) 39 | if (is.pixset(imorpx)) 40 | { 41 | imorpx <- as.cimg(imorpx) 42 | } 43 | tmp <- tempfile(fileext = ".png") 44 | on.exit(unlink(tmp)) 45 | imager::save.image(imorpx, tmp) 46 | tesseract::ocr_data(tmp, engine = engine) 47 | } 48 | -------------------------------------------------------------------------------- /R/screened_poisson_equation.R: -------------------------------------------------------------------------------- 1 | #' Correct inhomogeneous background of image by solving Screened Poisson Equation 2 | #' 3 | #' @param im a grayscale image of class cimg 4 | #' @param lamda this function corrects inhomogeneous background while preserving image details. lamda controls the trade-off. when lamda is too large, this function acts as an edge detector. 5 | #' @param s saturation percentage. this function uses \code{\link{BalanceSimplest}}. s is used as both sleft and sright. that's why s can not be over 50\%. 6 | #' @param range this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1]. 7 | #' @return a grayscale image of class cimg 8 | #' @references Jean-Michel Morel, Ana-Belen Petro, and Catalina Sbert, Screened Poisson Equation for Image Contrast Enhancement, Image Processing On Line, 4 (2014), pp. 16-29. \doi{10.5201/ipol.2014.84} 9 | #' @author Shota Ochi 10 | #' @export 11 | #' @examples 12 | #' dev.new() 13 | #' par(mfcol = c(1,2)) 14 | #' boats_g <- grayscale(boats) 15 | #' plot(boats_g, main = "Original") 16 | #' SPE(boats_g, 0.1) %>% plot(main = "Screened Poisson Equation") 17 | SPE <- function(im, lamda, s = 0.1, range = c(0, 255)) 18 | { 19 | assert_im(im) 20 | assert_range(range) 21 | assert_positive0_numeric_one_elem(lamda) 22 | assert_positive0_numeric_one_elem(s) 23 | im <- BalanceSimplest(im, s, s, range) 24 | im_dct <- DCT2D(im, returnmat = TRUE) 25 | im_dct_spe <- screened_poisson_dct(im_dct, lamda) 26 | im_corrected <- IDCT2D(im_dct_spe) %>% BalanceSimplest(s, s, range) 27 | return(im_corrected) 28 | } 29 | -------------------------------------------------------------------------------- /man/ThresholdAdaptive.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/local_adaptive_thresholding.R 3 | \name{ThresholdAdaptive} 4 | \alias{ThresholdAdaptive} 5 | \title{Local Adaptive Thresholding} 6 | \usage{ 7 | ThresholdAdaptive(im, k, windowsize = 17, range = c(0, 255)) 8 | } 9 | \arguments{ 10 | \item{im}{a grayscale image of class cimg} 11 | 12 | \item{k}{a numeric in the range [0,1]. when k is high, local threshold values tend to be lower. when k is low, local threshold value tend to be higher.} 13 | 14 | \item{windowsize}{windowsize controls the number of local neighborhood} 15 | 16 | \item{range}{this function assumes that the range of pixel values of of input image is [0,255] by default. you may prefer [0,1]. 17 | Note that range determines the max standard deviation. The max standard deviation plays an important role in this function.} 18 | } 19 | \value{ 20 | a pixel set 21 | } 22 | \description{ 23 | Local Adaptive Thresholding 24 | } 25 | \examples{ 26 | layout(matrix(1:4, 2, 2)) 27 | plot(papers, main = "Original") 28 | threshold(papers) \%>\% plot(main = "A variant of Otsu") 29 | ThresholdAdaptive(papers, 0, range = c(0,1)) \%>\% plot(main = "local adaptive (k = 0)") 30 | ThresholdAdaptive(papers, 0.2, range = c(0,1)) \%>\% plot(main = "local adaptive (k = 0.2)") 31 | } 32 | \references{ 33 | Faisal Shafait, Daniel Keysers, Thomas M. Breuel, "Efficient implementation of local adaptive thresholding techniques using integral images", Proc. SPIE 6815, Document Recognition and Retrieval XV, 681510 (28 January 2008) 34 | } 35 | \author{ 36 | Shota Ochi 37 | } 38 | -------------------------------------------------------------------------------- /man/ThresholdFuzzy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fuzzy_thresholding.R 3 | \name{ThresholdFuzzy} 4 | \alias{ThresholdFuzzy} 5 | \title{Fuzzy Entropy Image Segmentation} 6 | \usage{ 7 | ThresholdFuzzy( 8 | im, 9 | n = 50, 10 | maxiter = 100, 11 | omegamax = 0.9, 12 | omegamin = 0.1, 13 | c1 = 2, 14 | c2 = 2, 15 | mutrate = 0.2, 16 | vmaxcoef = 0.1, 17 | intervalnumber = 1000, 18 | returnvalue = FALSE 19 | ) 20 | } 21 | \arguments{ 22 | \item{im}{a grayscale image of class cimg} 23 | 24 | \item{n}{swarm size} 25 | 26 | \item{maxiter}{maximum iterative time} 27 | 28 | \item{omegamax}{maximum inertia weight} 29 | 30 | \item{omegamin}{minimum inertia weight} 31 | 32 | \item{c1}{acceleration coefficient} 33 | 34 | \item{c2}{acceleration coefficient} 35 | 36 | \item{mutrate}{rate of gaussian mutation} 37 | 38 | \item{vmaxcoef}{coefficient of maximum velocity} 39 | 40 | \item{intervalnumber}{interval number of histogram} 41 | 42 | \item{returnvalue}{if returnvalue is TRUE, returns a threshold value. if FALSE, returns a pixel set.} 43 | } 44 | \value{ 45 | a pixel set or a numeric 46 | } 47 | \description{ 48 | automatic fuzzy thresholding based on particle swarm optimization 49 | } 50 | \examples{ 51 | g <- grayscale(boats) 52 | layout(matrix(1:2, 1, 2)) 53 | plot(g, main = "Original") 54 | ThresholdFuzzy(g) \%>\% plot(main = "Fuzzy Thresholding") 55 | } 56 | \references{ 57 | Linyi Li, Deren Li (2008). Fuzzy entropy image segmentation based on particle swarm optimization. Progress in Natural Science. 58 | } 59 | \author{ 60 | Shota Ochi 61 | } 62 | -------------------------------------------------------------------------------- /R/treat_color_image.R: -------------------------------------------------------------------------------- 1 | #' compute average of RGB channels 2 | #' 3 | #' @param imcol a color image of class cimg 4 | #' @return a grayscale image of class cimg 5 | #' @author Shota Ochi 6 | #' @export 7 | #' @examples 8 | #' Grayscale(boats) %>% plot 9 | Grayscale <- function(imcol) 10 | { 11 | assert_imcol(imcol) 12 | (R(imcol) + G(imcol) + B(imcol)) / 3 13 | } 14 | 15 | #' store hue of color image 16 | #' 17 | #' @param imcol a color image of class cimg 18 | #' @return a color image of class cimg 19 | #' @author Shota Ochi 20 | #' @export 21 | #' @examples 22 | #' GetHue(boats) 23 | GetHue <- function(imcol) 24 | { 25 | assert_imcol(imcol) 26 | res <- imfill(dim=dim(imcol)) %>% add.color 27 | sumRGB <- Grayscale(imcol) 28 | pixels0 <- where(sumRGB == 0) 29 | at(sumRGB, pixels0[,"x"], pixels0[,"y"]) <- 1 30 | R(res) <- R(imcol) / sumRGB 31 | G(res) <- G(imcol) / sumRGB 32 | B(res) <- B(imcol) / sumRGB 33 | return(res) 34 | } 35 | 36 | #' restore hue of color image 37 | #' 38 | #' @param im a grayscale image of class cimg 39 | #' @param hueim a color image of class cimg 40 | #' @return a color image of class cimg 41 | #' @author Shota Ochi 42 | #' @export 43 | #' @examples 44 | #' g <- Grayscale(boats) 45 | #' hue <- GetHue(boats) 46 | #' layout(matrix(1:2, 1, 2)) 47 | #' plot(g, main = "Original") 48 | #' RestoreHue(g, hue) %>% plot(main="Resotred") 49 | RestoreHue <- function(im, hueim) 50 | { 51 | assert_im(im) 52 | assert_imcol(hueim) 53 | res <- imfill(dim=dim(im)) %>% add.color 54 | R(res) <- im * R(hueim) 55 | G(res) <- im * G(hueim) 56 | B(res) <- im * B(hueim) 57 | return(res) 58 | } 59 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - main 5 | - master 6 | pull_request: 7 | branches: 8 | - main 9 | - master 10 | 11 | name: test-coverage 12 | 13 | jobs: 14 | test-coverage: 15 | runs-on: macOS-latest 16 | env: 17 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 18 | steps: 19 | - uses: actions/checkout@v2 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | 23 | - uses: r-lib/actions/setup-pandoc@v2 24 | 25 | - name: Install X11 dependencies on MacOS 26 | if: runner.os == 'macOS' 27 | run: | 28 | brew install --cask xquartz 29 | 30 | - name: Query dependencies 31 | run: | 32 | install.packages('remotes') 33 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 34 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 35 | shell: Rscript {0} 36 | 37 | - name: Cache R packages 38 | uses: actions/cache@v2 39 | with: 40 | path: ${{ env.R_LIBS_USER }} 41 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 42 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 43 | 44 | - name: Install dependencies 45 | run: | 46 | remotes::install_deps(dependencies = TRUE, type = "source") 47 | remotes::install_cran("covr") 48 | shell: Rscript {0} 49 | 50 | - name: Test coverage 51 | run: covr::codecov() 52 | shell: Rscript {0} 53 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(BalanceSimplest) 4 | export(DCT2D) 5 | export(DenoiseDCT) 6 | export(EqualizeADP) 7 | export(EqualizeDP) 8 | export(EqualizePiecewise) 9 | export(GetHue) 10 | export(Grayscale) 11 | export(IDCT2D) 12 | export(OCR) 13 | export(OCR_data) 14 | export(RestoreHue) 15 | export(SPE) 16 | export(SegmentCV) 17 | export(ThresholdAdaptive) 18 | export(ThresholdFuzzy) 19 | export(ThresholdML) 20 | export(ThresholdTriclass) 21 | importFrom(Rcpp,sourceCpp) 22 | importFrom(checkmate,assert) 23 | importFrom(checkmate,assert_character) 24 | importFrom(checkmate,assert_class) 25 | importFrom(checkmate,assert_logical) 26 | importFrom(checkmate,assert_numeric) 27 | importFrom(checkmate,check_character) 28 | importFrom(checkmate,check_class) 29 | importFrom(checkmate,check_matrix) 30 | importFrom(checkmate,check_numeric) 31 | importFrom(checkmate,test_numeric) 32 | importFrom(fftwtools,fftw2d) 33 | importFrom(imager,"B<-") 34 | importFrom(imager,"G<-") 35 | importFrom(imager,"R<-") 36 | importFrom(imager,"at<-") 37 | importFrom(imager,B) 38 | importFrom(imager,G) 39 | importFrom(imager,R) 40 | importFrom(imager,add.color) 41 | importFrom(imager,as.cimg) 42 | importFrom(imager,as.pixset) 43 | importFrom(imager,depth) 44 | importFrom(imager,grabRect) 45 | importFrom(imager,height) 46 | importFrom(imager,imfill) 47 | importFrom(imager,is.cimg) 48 | importFrom(imager,is.pixset) 49 | importFrom(imager,save.image) 50 | importFrom(imager,spectrum) 51 | importFrom(imager,threshold) 52 | importFrom(imager,where) 53 | importFrom(imager,width) 54 | importFrom(magrittr,"%>%") 55 | useDynLib(imagerExtra, .registration=TRUE) 56 | -------------------------------------------------------------------------------- /R/simplest_color_balance.R: -------------------------------------------------------------------------------- 1 | #' Balance color of image by Simplest Color Balance 2 | #' 3 | #' @param im a grayscale image of class cimg 4 | #' @param sleft left saturation percentage. sleft can be specified by numeric or string, e.g. 1 and "1\%". note that sleft is a percentile. 5 | #' @param sright right saturation percentage. sright can be specified by numeric or string. note that sright is a percentile. 6 | #' @param range this function assumes that the range of pixel values of of input image is [0,255] by default. you may prefer [0,1]. 7 | #' @return a grayscale image of class cimg 8 | #' @references Nicolas Limare, Jose-Luis Lisani, Jean-Michel Morel, Ana Belen Petro, and Catalina Sbert, Simplest Color Balance, Image Processing On Line, 1 (2011), pp. 297-315. \doi{10.5201/ipol.2011.llmps-scb} 9 | #' @author Shota Ochi 10 | #' @export 11 | #' @examples 12 | #' dev.new() 13 | #' par(mfcol = c(1,2)) 14 | #' boats_g <- grayscale(boats) 15 | #' plot(boats_g, main = "Original") 16 | #' BalanceSimplest(boats_g, 1, 1) %>% plot(., main = "Simplest Color Balance") 17 | BalanceSimplest <- function(im, sleft, sright, range = c(0,255)) 18 | { 19 | assert_im(im) 20 | assert_range(range) 21 | sleft <- assert_s(sleft) 22 | sright <- assert_s(sright) 23 | assert_s_left_right(sleft, sright) 24 | 25 | dim_im <- dim(im) 26 | im <- as.vector(im) 27 | im_ordered <- im[order(im)] 28 | size_im <- length(im) 29 | end_left <- as.integer(sleft / 100 * size_im + 1) 30 | end_right <- as.integer((100 - sright) / 100 * size_im) 31 | min_im <- im_ordered[end_left] 32 | max_im <- im_ordered[end_right] 33 | res <- saturateim(im, max_im, min_im, range[2], range[1]) 34 | return(as.cimg(res, dim = dim_im)) 35 | } 36 | -------------------------------------------------------------------------------- /R/misc.R: -------------------------------------------------------------------------------- 1 | #' imagerExtra: Extra Image Processing Library Based on Imager 2 | #' 3 | #' imagerExtra is built on imager. imager by Simon Simon Barthelme provides an interface with CImg that is a C++ library for image processing. imager makes functions of CImg accessible from R and adds many utilities for accessing and working with image data from R. 4 | #' imagerExtra provides advanced functions for image processing based on imager. 5 | #' @docType package 6 | #' @name imagerExtra 7 | NULL 8 | 9 | #' @useDynLib imagerExtra, .registration=TRUE 10 | #' @importFrom checkmate assert 11 | #' @importFrom checkmate assert_character 12 | #' @importFrom checkmate assert_class 13 | #' @importFrom checkmate assert_logical 14 | #' @importFrom checkmate assert_numeric 15 | #' @importFrom checkmate check_character 16 | #' @importFrom checkmate check_class 17 | #' @importFrom checkmate check_matrix 18 | #' @importFrom checkmate check_numeric 19 | #' @importFrom checkmate test_numeric 20 | #' @importFrom fftwtools fftw2d 21 | #' @importFrom imager add.color 22 | #' @importFrom imager as.cimg 23 | #' @importFrom imager as.pixset 24 | #' @importFrom imager at<- 25 | #' @importFrom imager B 26 | #' @importFrom imager B<- 27 | #' @importFrom imager depth 28 | #' @importFrom imager G 29 | #' @importFrom imager G<- 30 | #' @importFrom imager grabRect 31 | #' @importFrom imager height 32 | #' @importFrom imager imfill 33 | #' @importFrom imager is.cimg 34 | #' @importFrom imager is.pixset 35 | #' @importFrom imager R 36 | #' @importFrom imager R<- 37 | #' @importFrom imager save.image 38 | #' @importFrom imager spectrum 39 | #' @importFrom imager threshold 40 | #' @importFrom imager where 41 | #' @importFrom imager width 42 | #' @importFrom magrittr %>% 43 | #' @importFrom Rcpp sourceCpp 44 | NULL 45 | -------------------------------------------------------------------------------- /man/EqualizePiecewise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/piecewize_equalization.R 3 | \name{EqualizePiecewise} 4 | \alias{EqualizePiecewise} 5 | \title{Piecewise Affine Histogram Equalization} 6 | \usage{ 7 | EqualizePiecewise(im, N, smax = 255, smin = 0, range = c(0, 255)) 8 | } 9 | \arguments{ 10 | \item{im}{a grayscale image of class cimg} 11 | 12 | \item{N}{number of subintervals of partition. N controls how the input gray levels will be mapped in the output image. 13 | if N is large, Piecewise Affine Equalization and Histogram Equalization are very similar.} 14 | 15 | \item{smax}{maximum value of slopes. if smax is small, contrast enhancement is suppressed.} 16 | 17 | \item{smin}{minimum value of slopes. if smin is large, contrast enhancement is propelled, and saturations occur excessively.} 18 | 19 | \item{range}{range of the pixel values of image. this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1]. 20 | if you change range, you should change smax. one example is this (smax = range[2] - range[1]).} 21 | } 22 | \value{ 23 | a grayscale image of class cimg 24 | } 25 | \description{ 26 | enhance contrast of image by piecewise affine histogram equalization 27 | } 28 | \examples{ 29 | dev.new() 30 | par(mfcol = c(1,2)) 31 | boats_g <- grayscale(boats) 32 | plot(boats_g, main = "Original") 33 | EqualizePiecewise(boats_g, 10) \%>\% plot(., main = "Piecewise Affine Equalization") 34 | } 35 | \references{ 36 | Jose-Luis Lisani, Ana-Belen Petro, and Catalina Sbert, Color and Contrast Enhancement by Controlled Piecewise Affine Histogram Equalization, Image Processing On Line, 2 (2012), pp. 243-265. \doi{10.5201/ipol.2012.lps-pae} 37 | } 38 | \author{ 39 | Shota Ochi 40 | } 41 | -------------------------------------------------------------------------------- /man/SegmentCV.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/chan_vese_segmentation.R 3 | \name{SegmentCV} 4 | \alias{SegmentCV} 5 | \title{Chan-Vese segmentation} 6 | \usage{ 7 | SegmentCV( 8 | im, 9 | mu = 0.25, 10 | nu = 0, 11 | lambda1 = 1, 12 | lambda2 = 1, 13 | tol = 1e-04, 14 | maxiter = 500, 15 | dt = 0.5, 16 | initial, 17 | returnstep 18 | ) 19 | } 20 | \arguments{ 21 | \item{im}{a grayscale image of class cimg} 22 | 23 | \item{mu}{length penalty} 24 | 25 | \item{nu}{area penalty} 26 | 27 | \item{lambda1}{fit weight inside the curve} 28 | 29 | \item{lambda2}{fit weight outside the curve} 30 | 31 | \item{tol}{convergence tolerance} 32 | 33 | \item{maxiter}{maximum number of iterations} 34 | 35 | \item{dt}{time step} 36 | 37 | \item{initial}{"interactive" or a grayscale image of class cimg. you can define initial condition as a rectangle shape interactively if initial is "interactive". If initial is a grayscale image of class cimg, pixels whose values are negative will be treated as outside of contour. pixels whose values are non-negative will be treated as inside of contour. checker board condition will be used if initial is not specified.} 38 | 39 | \item{returnstep}{a numeric vector that determines which result will be returned. 0 means initial condition, and 1 means the result after 1 iteration. final result will be returned if returnstep is not specified.} 40 | } 41 | \value{ 42 | a pixel set or a list of lists of numeric and pixel set 43 | } 44 | \description{ 45 | iterative image segmentation with Chan-Vese model 46 | } 47 | \examples{ 48 | layout(matrix(1:2, 1, 2)) 49 | g <- grayscale(dogs) 50 | plot(g, main = "Original") 51 | SegmentCV(g, lambda2 = 15) \%>\% plot(main = "Binarized") 52 | } 53 | \references{ 54 | Pascal Getreuer (2012). Chan-Vese Segmentation. Image Processing On Line 2, 214-224. 55 | } 56 | \author{ 57 | Shota Ochi 58 | } 59 | -------------------------------------------------------------------------------- /R/fast_discrete_cosine_transoformation.R: -------------------------------------------------------------------------------- 1 | #' Two Dimensional Discrete Cosine Transformation and Inverse Cosine Transformation 2 | #' 3 | #' DCT2D computes two dimensional discrete cosine transformation. 4 | #' IDCT2D computes two dimensional inverse discrete cosine transformation. 5 | #' @name DCT 6 | #' @param imormat a grayscale image of class cimg or a numeric matrix 7 | #' @param returnmat if returnmat is TRUE, returns numeric matrix. if FALSE, returns a grayscale image of class cimg. 8 | #' @return a grayscale image of class cimg or a numeric matrix 9 | #' @references Makhoul, J. (1980). A fast cosine transform in one and two dimensions. IEEE Transactions on Acoustics, Speech, and Signal Processing. 28 (1): 27-34. 10 | #' @author Shota Ochi 11 | #' @examples 12 | #' g <- grayscale(boats) 13 | #' layout(matrix(1:2, 1, 2)) 14 | #' plot(g, main = "Original") 15 | #' gg <- DCT2D(g) %>% IDCT2D() %>% plot(main = "Transformed") 16 | #' mean((g - gg)^2) 17 | NULL 18 | 19 | #' @rdname DCT 20 | #' @export 21 | DCT2D <- function(imormat, returnmat = FALSE) 22 | { 23 | assert_im_mat(imormat) 24 | assert_logical_one_elem(returnmat) 25 | if (is.cimg(imormat)) 26 | { 27 | imormat <- as.matrix(imormat) 28 | } 29 | temp <- DCT2D_reorder(imormat) 30 | temp <- fftw2d(temp) 31 | res <- DCT2D_fromDFT(temp) 32 | if (returnmat) 33 | { 34 | return(res) 35 | } 36 | return(as.cimg(res)) 37 | } 38 | 39 | #' @rdname DCT 40 | #' @export 41 | IDCT2D <- function(imormat, returnmat = FALSE) 42 | { 43 | assert_im_mat(imormat) 44 | assert_logical_one_elem(returnmat) 45 | if (is.cimg(imormat)) 46 | { 47 | imormat <- as.matrix(imormat) 48 | } 49 | dimim <- dim(imormat) 50 | size <- dimim[1] * dimim[2] 51 | temp <- IDCT2D_toDFT(imormat) 52 | temp <- Re(fftw2d(temp, inverse = 1)) 53 | res <- IDCT2D_retrievex(temp) / size 54 | if (returnmat) 55 | { 56 | return(res) 57 | } 58 | return(as.cimg(res)) 59 | } -------------------------------------------------------------------------------- /tests/testthat/test_multilevel_thresholding.R: -------------------------------------------------------------------------------- 1 | test_that("multilevel thresholding", 2 | { 3 | bad1 <- NA 4 | 5 | k_c <- 2 6 | 7 | vec_good <- c(0.1,0.5) 8 | vec_bad <- c(1, NA) 9 | vec_badorder <- c(0.5, 0.1) 10 | 11 | thr_bad <- "error" 12 | 13 | expect_error(ThresholdML(gim_bad, k_c)) 14 | expect_error(ThresholdML(gim_uniform, k_c)) 15 | 16 | expect_error(ThresholdML(gim, bad1)) 17 | expect_error(ThresholdML(gim, 0.1)) 18 | 19 | expect_error(ThresholdML(gim, k_c, returnvalue = bad1)) 20 | 21 | expect_error(ThresholdML(gim, k_c, thr = bad1)) 22 | expect_error(ThresholdML(gim, thr = vec_bad)) 23 | expect_error(ThresholdML(gim, thr = thr_bad)) 24 | expect_warning(ThresholdML(gim, thr = vec_badorder)) 25 | 26 | expect_error(ThresholdML(gim, k_c, thr = "manual", sn = bad1)) 27 | expect_error(ThresholdML(gim, k_c, thr = "manual", sn = 1)) 28 | 29 | expect_error(ThresholdML(gim, k_c, thr = "manual", mcn = bad1)) 30 | expect_error(ThresholdML(gim, k_c, thr = "manual", mcn = 0.1)) 31 | 32 | expect_error(ThresholdML(gim, k_c, thr = "manual", limit = bad1)) 33 | expect_error(ThresholdML(gim, k_c, thr = "manual", limit = 0.1)) 34 | 35 | expect_error(ThresholdML(gim, k_c, thr = "manual", intervalnumber = bad1)) 36 | expect_error(ThresholdML(gim, k_c, thr = "manual", intervalnumber = 1)) 37 | 38 | expect_class(ThresholdML(gim, k_c, returnvalue = TRUE), "numeric") 39 | expect_class(ThresholdML(gim, k_c), class_imager) 40 | expect_class(ThresholdML(gim, k_c, thr = "precise", returnvalue = TRUE), "numeric") 41 | expect_class(ThresholdML(gim, k_c, thr = "precise"), class_imager) 42 | expect_class(ThresholdML(gim, k_c, thr = "manual", returnvalue = TRUE), "numeric") 43 | expect_class(ThresholdML(gim, k_c, thr = "manual"), class_imager) 44 | expect_class(ThresholdML(gim, thr = vec_good, returnvalue = TRUE), "numeric") 45 | expect_class(ThresholdML(gim, thr = vec_good), class_imager) 46 | }) 47 | -------------------------------------------------------------------------------- /man/ThresholdML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multilevel_thresholding.R 3 | \name{ThresholdML} 4 | \alias{ThresholdML} 5 | \title{Multilevel Thresholding} 6 | \usage{ 7 | ThresholdML( 8 | im, 9 | k, 10 | thr = "fast", 11 | sn = 30, 12 | mcn = 100, 13 | limit = 100, 14 | intervalnumber = 1000, 15 | returnvalue = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{im}{a grayscale image of class cimg} 20 | 21 | \item{k}{level of thresholding. k is ignored when thr is a numeric vector.} 22 | 23 | \item{thr}{thresholds, either numeric vector, or "fast", or "precise", or "manual".} 24 | 25 | \item{sn}{population size. sn is ignored except when thr is "manual".} 26 | 27 | \item{mcn}{maximum cycle number. mcn is ignored except when thr is "manual".} 28 | 29 | \item{limit}{abandonment criteria. limit is ignored except when thr is "manual".} 30 | 31 | \item{intervalnumber}{interval number of histogram. intervalnumber is ignored except when thr is "manual".} 32 | 33 | \item{returnvalue}{if returnvalue is TRUE, returns threshold values. if FALSE, returns a grayscale image of class cimg.} 34 | } 35 | \value{ 36 | a grayscale image of class cimg or a numeric vector 37 | } 38 | \description{ 39 | Segments a grayscale image into several gray levels. 40 | Multilevel thresholding selection based on the artificial bee colony algorithm is used when thr is not a numeric vector. Preset parameters for fast computing is used when thr is "fast". Preset parameters for precise computing is used when thr is "precise". You can tune the parameters if thr is "manual". 41 | Also you can specify the values of thresholds by setting thr as a numeric vector. 42 | } 43 | \examples{ 44 | g <- grayscale(boats) 45 | ThresholdML(g, k = 2) \%>\% plot 46 | } 47 | \references{ 48 | Ming-HuwiHorng (2011). Multilevel thresholding selection based on the artificial bee colony algorithm for image segmentation. Expert Systems with Applications. 49 | } 50 | \author{ 51 | Shota Ochi 52 | } 53 | -------------------------------------------------------------------------------- /R/piecewize_equalization.R: -------------------------------------------------------------------------------- 1 | #' Piecewise Affine Histogram Equalization 2 | #' 3 | #' enhance contrast of image by piecewise affine histogram equalization 4 | #' @param im a grayscale image of class cimg 5 | #' @param N number of subintervals of partition. N controls how the input gray levels will be mapped in the output image. 6 | #' if N is large, Piecewise Affine Equalization and Histogram Equalization are very similar. 7 | #' @param smax maximum value of slopes. if smax is small, contrast enhancement is suppressed. 8 | #' @param smin minimum value of slopes. if smin is large, contrast enhancement is propelled, and saturations occur excessively. 9 | #' @param range range of the pixel values of image. this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1]. 10 | #' if you change range, you should change smax. one example is this (smax = range[2] - range[1]). 11 | #' @return a grayscale image of class cimg 12 | #' @references Jose-Luis Lisani, Ana-Belen Petro, and Catalina Sbert, Color and Contrast Enhancement by Controlled Piecewise Affine Histogram Equalization, Image Processing On Line, 2 (2012), pp. 243-265. \doi{10.5201/ipol.2012.lps-pae} 13 | #' @author Shota Ochi 14 | #' @export 15 | #' @examples 16 | #' dev.new() 17 | #' par(mfcol = c(1,2)) 18 | #' boats_g <- grayscale(boats) 19 | #' plot(boats_g, main = "Original") 20 | #' EqualizePiecewise(boats_g, 10) %>% plot(., main = "Piecewise Affine Equalization") 21 | EqualizePiecewise <- function(im, N, smax = 255, smin = 0, range = c(0, 255)) 22 | { 23 | assert_im(im) 24 | assert_range(range) 25 | assert_positive0_numeric_one_elem(N) 26 | assert_positive_numeric_one_elem(smax) 27 | assert_positive0_numeric_one_elem(smin) 28 | dim_im <- dim(im) 29 | im <- as.vector(im) 30 | im_sorted <- im[order(im)] 31 | max_im <- max(im) 32 | min_im <- min(im) 33 | res <- piecewise_transformation(im, im_sorted, N, smax, smin, max_im, min_im, range[2], range[1]) 34 | return(as.cimg(res, dim = dim_im)) 35 | } 36 | -------------------------------------------------------------------------------- /tests/testthat/test_chan_vese_segmentation.R: -------------------------------------------------------------------------------- 1 | # check assert_numeric_vec(), assert_numeric_one_elem(), and assert_positive0_numeric_one_elem() 2 | 3 | test_that("Chan-Vese segmentation", 4 | { 5 | num_one_bad1 <- "A" 6 | num_one_bad2 <- -1 7 | num_one_bad3 <- c(0.1,0.1,0.1) 8 | num_one_bad4 <- NA 9 | num_one_bad5 <- NULL 10 | num_one_bad6 <- 0 11 | 12 | expect_error(SegmentCV(gim_bad)) 13 | 14 | expect_error(SegmentCV(gim, mu = num_one_bad1)) 15 | expect_error(SegmentCV(gim, mu = num_one_bad3)) 16 | expect_error(SegmentCV(gim, mu = num_one_bad4)) 17 | expect_error(SegmentCV(gim, mu = num_one_bad5)) 18 | 19 | expect_error(SegmentCV(gim, nu = num_one_bad4)) 20 | 21 | expect_error(SegmentCV(gim, lambda1 = num_one_bad1)) 22 | expect_error(SegmentCV(gim, lambda1 = num_one_bad3)) 23 | expect_error(SegmentCV(gim, lambda1 = num_one_bad4)) 24 | expect_error(SegmentCV(gim, lambda1 = num_one_bad5)) 25 | 26 | expect_error(SegmentCV(gim, lambda2 = num_one_bad4)) 27 | 28 | expect_error(SegmentCV(gim, tol = num_one_bad1)) 29 | expect_error(SegmentCV(gim, tol = num_one_bad2)) 30 | expect_error(SegmentCV(gim, tol = num_one_bad3)) 31 | expect_error(SegmentCV(gim, tol = num_one_bad4)) 32 | expect_error(SegmentCV(gim, tol = num_one_bad5)) 33 | 34 | expect_error(SegmentCV(gim, maxiter = num_one_bad4)) 35 | 36 | expect_error(SegmentCV(gim, dt = num_one_bad4)) 37 | 38 | expect_error(SegmentCV(gim, initial = num_one_bad2)) 39 | expect_error(SegmentCV(gim, initial = num_one_bad3)) 40 | expect_error(SegmentCV(gim, initial = num_one_bad4)) 41 | expect_error(SegmentCV(gim, initial = num_one_bad5)) 42 | expect_error(SegmentCV(gim, initial = 1)) 43 | 44 | expect_error(SegmentCV(gim, returnstep = num_one_bad1)) 45 | expect_error(SegmentCV(gim, returnstep = num_one_bad2)) 46 | expect_error(SegmentCV(gim, returnstep = num_one_bad4)) 47 | expect_error(SegmentCV(gim, returnstep = num_one_bad5)) 48 | 49 | expect_class(SegmentCV(gim), class_pixset) 50 | expect_class(SegmentCV(gim, returnstep = c(1)), "list") 51 | }) 52 | -------------------------------------------------------------------------------- /vignettes/ocr.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Optical Character Recognition with imagerExtra" 3 | author: "Shota Ochi" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Optical Character Recognition with imagerExtra} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | 24 | 25 | ```{r setup, include = FALSE} 26 | knitr::opts_chunk$set(warning = FALSE, message = FALSE, cache = FALSE, 27 | comment = NA, verbose = TRUE, fig.width = 5, fig.height = 5, dev = 'jpeg', dev.args=list(quality=50)) 28 | is_available_tesseract <- requireNamespace("tesseract", quietly = TRUE) 29 | ``` 30 | 31 | You need the R package tesseract, which is bindings to a powerful optical character recognition (OCR) engine, to do OCR with imagerExtra. 32 | 33 | See the [installation guide of tesseract](https://github.com/ropensci/tesseract#installation) if you haven't installed tesseract. 34 | 35 | ocr function of tesseract works best for images with high contrast, little noise, and horizontal text. 36 | 37 | ocr function doesn't show a good performance for degraded images as shown below. 38 | ```{r, fig.height = 3, eval = is_available_tesseract} 39 | library(imagerExtra) 40 | plot(papers, main = "Original") 41 | OCR(papers) %>% print 42 | OCR_data(papers) %>% print 43 | ``` 44 | 45 | OCR function and OCR_data function are wrappers for ocr function and ocr_data function of tesseract. 46 | 47 | We can see OCR function and OCR_data function failed to recognize the text "Hello". 48 | 49 | We need to clean the image before using OCR function. 50 | 51 | ```{r, fig.height = 3, eval = is_available_tesseract} 52 | hello <- DenoiseDCT(papers, 0.01) %>% ThresholdAdaptive(., 0.1, range = c(0,1)) 53 | plot(hello, main = "Hello") 54 | OCR(hello) %>% print 55 | OCR_data(hello) %>% print 56 | ``` 57 | 58 | We can see the text "Hello" was recognized. 59 | 60 | Using tesseract in combination with imagerExtra enables us to extract text from degraded images. 61 | -------------------------------------------------------------------------------- /src/simplest_color_balance.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2011 Catalina Sbert 3 | * All rights reserved 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | //$ The code below was written by modifying piecewise_transformation function in piecewise_transformation.cpp file. 20 | //$ That's why the copy right holder of the code below is Catalina Sbert. 21 | 22 | #include 23 | 24 | 25 | /** 26 | * @brief Main block of Simplest Color Balance 27 | * 28 | * @param data initial array 29 | * @param max_im maximum of the saturated image 30 | * @param min_im minimum of the saturated image 31 | * @param max_range maximum of the range of the pixel values 32 | * @param min_range minimum of the range of the pixel values 33 | **/ 34 | // [[Rcpp::export]] 35 | Rcpp::NumericVector saturateim(Rcpp::NumericVector data, double max_im, double min_im, double max_range, double min_range) 36 | { 37 | int n = data.size(); 38 | Rcpp::NumericVector data_out(n); 39 | data_out.fill(0.0); 40 | double* ptr_data_out = data_out.begin(); 41 | double slope = (max_range - min_range) / (max_im - min_im); 42 | 43 | for (int i = 0; i < n; ++i) 44 | { 45 | if (data[i] > max_im) 46 | { 47 | ptr_data_out[i] = max_range; 48 | continue; 49 | } 50 | if (data[i] < min_im) 51 | { 52 | ptr_data_out[i] = min_range; 53 | continue; 54 | } 55 | ptr_data_out[i] = slope * (data[i] - min_im) + min_range; 56 | } 57 | return data_out; 58 | } 59 | 60 | -------------------------------------------------------------------------------- /R/local_adaptive_thresholding.R: -------------------------------------------------------------------------------- 1 | #' Local Adaptive Thresholding 2 | #' 3 | #' @param im a grayscale image of class cimg 4 | #' @param k a numeric in the range [0,1]. when k is high, local threshold values tend to be lower. when k is low, local threshold value tend to be higher. 5 | #' @param windowsize windowsize controls the number of local neighborhood 6 | #' @param range this function assumes that the range of pixel values of of input image is [0,255] by default. you may prefer [0,1]. 7 | #' Note that range determines the max standard deviation. The max standard deviation plays an important role in this function. 8 | #' @return a pixel set 9 | #' @references Faisal Shafait, Daniel Keysers, Thomas M. Breuel, "Efficient implementation of local adaptive thresholding techniques using integral images", Proc. SPIE 6815, Document Recognition and Retrieval XV, 681510 (28 January 2008) 10 | #' @author Shota Ochi 11 | #' @export 12 | #' @examples 13 | #' layout(matrix(1:4, 2, 2)) 14 | #' plot(papers, main = "Original") 15 | #' threshold(papers) %>% plot(main = "A variant of Otsu") 16 | #' ThresholdAdaptive(papers, 0, range = c(0,1)) %>% plot(main = "local adaptive (k = 0)") 17 | #' ThresholdAdaptive(papers, 0.2, range = c(0,1)) %>% plot(main = "local adaptive (k = 0.2)") 18 | ThresholdAdaptive <- function(im, k, windowsize = 17, range = c(0,255)) 19 | { 20 | assert_im(im) 21 | assert_positive0_numeric_one_elem(k) 22 | assert_positive_numeric_one_elem(windowsize) 23 | assert_range(range) 24 | windowsize <- as.integer(windowsize) 25 | if (windowsize <= 2) 26 | { 27 | stop("windowsize must be greater than or equal to 3") 28 | } 29 | if (windowsize %% 2 == 0) 30 | { 31 | warning(sprintf("windowsize is even (%d). windowsize will be treated as %d", windowsize, windowsize+1)) 32 | windowsize <- as.integer(windowsize + 1) 33 | } 34 | if (windowsize >= width(im) || windowsize >= height(im)) 35 | { 36 | stop("windowsize is too large.") 37 | } 38 | if (k > 1) 39 | { 40 | stop("k is out of range. k must be in [0,1].") 41 | } 42 | 43 | maxsd <- (range[2] - range[1]) / 2 44 | if (maxsd == 0) 45 | { 46 | stop("range[1] must not be same as range[2].") 47 | } 48 | 49 | res <- threshold_adaptive(as.matrix(im), k, windowsize, maxsd) 50 | return(as.pixset(as.cimg(res))) 51 | } 52 | -------------------------------------------------------------------------------- /src/screened_poisson_equation.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * 3 | * Copyright 2012 IPOL Image Processing On Line http://www.ipol.im/ 4 | * 5 | * 6 | * This program is free software: you can redistribute it and/or modify 7 | * it under the terms of the GNU General Public License as published by 8 | * the Free Software Foundation, either version 3 of the License, or 9 | * (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU General Public License 17 | * along with this program. If not, see . 18 | * 19 | * 20 | * @file screened_lib.c 21 | * @brief laplacian, DFT and Poisson routines 22 | * 23 | * @author Catalina Sbert 24 | */ 25 | 26 | #include 27 | 28 | /* M_PI is a POSIX definition */ 29 | #ifndef M_PI2 30 | /** macro definition for Pi² */ 31 | #define M_PI2 9.86960440109 32 | #endif /* !M_PI */ 33 | 34 | /** 35 | * @brief perform a screned Poisson PDE in the Fourier DCT space 36 | * 37 | * @f$ (PI² i²/nx²+ PI²j²/ny²+ lambda)u(i, j) = 38 | * =(PI² i²/nx²+ PI²j²/ny²) g(i,j) @f$ 39 | * 40 | * @param data input array dct of the input image of size nx x ny 41 | * @param nx data array size 42 | * @param ny data array size 43 | * @param L the constant of the screened equation 44 | * 45 | * @return the data array, update 46 | */ 47 | // [[Rcpp::export]] 48 | Rcpp::NumericMatrix screened_poisson_dct(Rcpp::NumericMatrix data, double L) 49 | { 50 | int nx = data.nrow(); 51 | int ny = data.ncol(); 52 | Rcpp::NumericMatrix data_out(Rcpp::Dimension(nx, ny)); 53 | double normx, normy, coeff, coeff1; 54 | normx = 4.0 * M_PI2 / (double)(nx * nx); 55 | normy = 4.0 * M_PI2 / (double)(ny * ny); 56 | 57 | if (L > 0.) 58 | { 59 | for (int i = 0; i < nx; ++i) 60 | { 61 | for (int j = 0; j < ny; ++j) 62 | { 63 | if (i == 0 && j == 0) 64 | { 65 | data_out(0, 0) = 0.; 66 | } else 67 | { 68 | coeff = normx * i * i + normy * j * j; 69 | coeff1 = coeff / (coeff + L); 70 | data_out(i, j) = data(i, j) * coeff1; 71 | } 72 | } 73 | } 74 | } 75 | return data_out; 76 | } -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # imagerExtra 2 | 3 | [![Build Status](https://github.com/ShotaOchi/imagerExtra/workflows/R-CMD-check/badge.svg)](https://github.com/ShotaOchi/imagerExtra/actions) 4 | [![CRAN Version](https://www.r-pkg.org/badges/version/imagerExtra)](https://cran.r-project.org/package=imagerExtra) 5 | [![License: GPL v3](https://img.shields.io/badge/License-GPL%20v3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0) 6 | [![codecov](https://codecov.io/gh/ShotaOchi/imagerExtra/branch/master/graph/badge.svg)](https://codecov.io/gh/ShotaOchi/imagerExtra) 7 | 8 | ## About 9 | imagerExtra is an R package for image processing based on the R package [imager](https://github.com/dahtah/imager). 10 | 11 | 12 | imagerExtra provides advanced functions for image processing. 13 | 14 | 15 | See the vignette [Getting Started with imagerExtra](https://cran.r-project.org/package=imagerExtra/vignettes/gettingstarted.html) to know what functions imagerExtra provides. 16 | 17 | 18 | See the [introduction of imager](http://dahtah.github.io/imager/) if you don't know imager. 19 | 20 | 21 | See the [vignette of imager](https://CRAN.R-project.org/package=imager/vignettes/gettingstarted.html) if you aren't familiar with imager. 22 | 23 | 24 | ## Installation 25 | You can install imagerExtra from CRAN or GitHub. 26 | 27 | 28 | Run the following R code to install imagerExtra. 29 | ```r 30 | # install from CRAN 31 | install.packages("imagerExtra") 32 | # install from GitHub 33 | devtools::install_github("ShotaOchi/imagerExtra") 34 | ``` 35 | 36 | ## Optical Character Recognition (OCR) 37 | You need the R package [tesseract](https://github.com/ropensci/tesseract#tesseract) to do OCR with imagerExtra. 38 | 39 | 40 | See the [installation guide of tesseract](https://github.com/ropensci/tesseract#installation) if you haven't installed tesseract. 41 | 42 | 43 | Here is a small demo that shows imagerExtra can expand the scope of the application of tesseract. 44 | ```r 45 | library(imagerExtra) 46 | # OCR doesn't work well for degraded images 47 | plot(papers) 48 | OCR(papers) 49 | # OCR works well for images with high contrast and little noise 50 | hello <- DenoiseDCT(papers, 0.01) %>% ThresholdAdaptive(., 0.1, range = c(0,1)) 51 | plot(hello) 52 | OCR(hello) 53 | ``` 54 | 55 | 56 | ## Contribution 57 | You can create issues for any bug report or suggestion on the [issues page](https://github.com/ShotaOchi/imagerExtra/issues). 58 | 59 | 60 | You're welcome to fork this repository and send me a pull request for bug fixes or additional features. 61 | 62 | 63 | ## Development Blog 64 | URL of development blog of imagerExtra is [https://shotaochi.github.io/](https://shotaochi.github.io/). 65 | -------------------------------------------------------------------------------- /tests/testthat/test_adaptive_double_plateaus_histogram_equalization.R: -------------------------------------------------------------------------------- 1 | # check assert_logical_one_elem() and assert_positive_numeric_one_elem() 2 | 3 | test_that("adaptive_double_plateaus_histogram_equalization", 4 | { 5 | t_up <- 1000 6 | t_down <- 100 7 | t_bad1 <- NULL 8 | t_bad2 <- NA 9 | t_bad3 <- "T" 10 | t_bad4 <- c(1,1) 11 | 12 | N_bad1 <- NULL 13 | N_bad2 <- NA 14 | N_bad3 <- "T" 15 | N_bad4 <- c(1,1) 16 | N_bad5 <- 1 17 | 18 | expect_error(EqualizeDP(gim_bad, t_down, t_up)) 19 | expect_error(EqualizeDP(gim_uniform, t_down, t_up)) 20 | 21 | expect_error(EqualizeDP(gim, t_down, t_up, range = range_bad1)) 22 | 23 | expect_error(EqualizeDP(gim, t_down, t_up, N_bad1)) 24 | expect_error(EqualizeDP(gim, t_down, t_up, N_bad2)) 25 | expect_error(EqualizeDP(gim, t_down, t_up, N_bad3)) 26 | expect_error(EqualizeDP(gim, t_down, t_up, N_bad4)) 27 | expect_error(EqualizeDP(gim, t_down, t_up, N_bad5)) 28 | 29 | expect_error(EqualizeDP(gim, t_down, t_bad1)) 30 | expect_error(EqualizeDP(gim, t_down, t_bad2)) 31 | expect_error(EqualizeDP(gim, t_down, t_bad3)) 32 | expect_error(EqualizeDP(gim, t_down, t_bad4)) 33 | expect_error(EqualizeDP(gim, t_bad1, t_up)) 34 | expect_error(EqualizeDP(gim, t_bad2, t_up)) 35 | expect_error(EqualizeDP(gim, t_bad3, t_up)) 36 | expect_error(EqualizeDP(gim, t_bad4, t_up)) 37 | expect_error(EqualizeDP(gim, t_up, t_down)) 38 | 39 | expect_class(EqualizeDP(gim, t_down, t_up), class_imager) 40 | 41 | n_bad <- 0 42 | n_bad1 <- -1 43 | n_bad2 <- NULL 44 | n_bad3 <- NA 45 | n_bad4 <- "A" 46 | n_bad5 <- 2 47 | 48 | N_bad1 <- NA 49 | N_bad2 <- 1 50 | 51 | param_boats <- EqualizeADP(gim, returnparam = TRUE) 52 | 53 | expect_error(EqualizeADP(gim_bad)) 54 | expect_error(EqualizeADP(gim_uniform)) 55 | 56 | expect_error(EqualizeADP(gim, n_bad)) 57 | expect_error(EqualizeADP(gim, n_bad1)) 58 | expect_error(EqualizeADP(gim, n_bad2)) 59 | expect_error(EqualizeADP(gim, n_bad3)) 60 | expect_error(EqualizeADP(gim, n_bad4)) 61 | expect_error(suppressWarnings(EqualizeADP(gim, n_bad5))) 62 | 63 | expect_error(EqualizeADP(gim, N = N_bad1)) 64 | expect_error(EqualizeADP(gim, N = N_bad2)) 65 | 66 | expect_error(EqualizeADP(gim, range = range_bad1)) 67 | 68 | expect_error(EqualizeADP(gim, return_bad1)) 69 | expect_error(EqualizeADP(gim, return_bad2)) 70 | expect_error(EqualizeADP(gim, return_bad3)) 71 | expect_error(EqualizeADP(gim, return_bad4)) 72 | expect_error(EqualizeADP(gim, return_bad5)) 73 | 74 | expect_equal(EqualizeDP(gim, param_boats[1], param_boats[2]), EqualizeADP(gim)) 75 | expect_class(EqualizeADP(gim), class_imager) 76 | expect_class(EqualizeADP(gim, returnparam = TRUE), "numeric") 77 | }) -------------------------------------------------------------------------------- /.github/workflows/test-with-valgrind.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - '**' 5 | pull_request: 6 | branches: 7 | - '**' 8 | 9 | name: test-with-valgrind 10 | 11 | jobs: 12 | test-with-valgrind: 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: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 22 | 23 | env: 24 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 25 | RSPM: ${{ matrix.config.rspm }} 26 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 27 | 28 | steps: 29 | - uses: actions/checkout@v2 30 | 31 | - uses: r-lib/actions/setup-r@v2 32 | with: 33 | r-version: ${{ matrix.config.r }} 34 | 35 | - uses: r-lib/actions/setup-pandoc@v2 36 | 37 | - name: Install system dependencies 38 | if: runner.os == 'Linux' 39 | run: | 40 | sudo apt install valgrind 41 | 42 | - name: Query dependencies 43 | run: | 44 | install.packages('remotes') 45 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 46 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 47 | shell: Rscript {0} 48 | 49 | - name: Cache R packages 50 | if: runner.os != 'Windows' 51 | uses: actions/cache@v2 52 | with: 53 | path: ${{ env.R_LIBS_USER }} 54 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 55 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 56 | 57 | - name: Install system dependencies 58 | if: runner.os == 'Linux' 59 | run: | 60 | while read -r cmd 61 | do 62 | eval sudo $cmd 63 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 64 | 65 | - name: Install dependencies 66 | run: | 67 | remotes::install_deps(dependencies = TRUE) 68 | remotes::install_cran("rcmdcheck") 69 | shell: Rscript {0} 70 | 71 | - name: Check 72 | env: 73 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 74 | run: | 75 | options(crayon.enabled = TRUE) 76 | rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--use-valgrind"), error_on = "warning", check_dir = "check") 77 | shell: Rscript {0} 78 | 79 | - name: Upload check results 80 | if: failure() 81 | uses: actions/upload-artifact@main 82 | with: 83 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 84 | path: check -------------------------------------------------------------------------------- /vignettes/color.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Treating Color Image with imagerExtra" 3 | author: "Shota Ochi" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Treating Color Image with imagerExtra} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | 24 | 25 | ```{r setup, include = FALSE} 26 | knitr::opts_chunk$set(warning=FALSE, message=FALSE, cache=FALSE, 27 | comment=NA, verbose=TRUE, fig.width=7.5, fig.height=5, dev='jpeg',dev.args=list(quality=50)) 28 | library(imager) 29 | res <- vector("list",3) 30 | a <- imfill(300, 300, 3, c(1,0,0)) %>% grayscale() 31 | res[[1]] <- unique(a) 32 | a <- imfill(300, 300, 3, c(0,1,0)) %>% grayscale() 33 | res[[2]] <- unique(a) 34 | a <- imfill(300, 300, 3, c(0,0,1)) %>% grayscale() 35 | res[[3]] <- unique(a) 36 | ``` 37 | 38 | We have two options when treating color images with imagerExtra. 39 | 40 | * process the channels independently 41 | * preserve the hue of image, process the intensity component and then compute RGB values from the new intensity component 42 | 43 | The former is straightforward. 44 | 45 | One example is shown below. 46 | 47 | ```{r, message = FALSE} 48 | library(imagerExtra) 49 | x <- boats 50 | s <- 0.1 51 | R(x) <- BalanceSimplest(R(x), s, s, range=c(0,1)) 52 | G(x) <- BalanceSimplest(G(x), s, s, range=c(0,1)) 53 | B(x) <- BalanceSimplest(B(x), s, s, range=c(0,1)) 54 | layout(matrix(1:2, 1, 2)) 55 | plot(boats, main = "Original") 56 | plot(x, main = "Independently Processed") 57 | ``` 58 | 59 | The latter needs three functions: Grayscale, GetHue, RestoreHue. 60 | 61 | * Grayscale: computes average of RGB channel 62 | * GetHue: stores hue of image 63 | * RestoreHue: restores hue of image 64 | 65 | grayscale function of imager computes as shown below by default. 66 | 67 | ```{r , echo = FALSE, size = "huge"} 68 | text1 <- sprintf("Y = %fR + %fG + %fB", res[[1]], res[[2]], res[[3]]) 69 | cat(text1) 70 | ``` 71 | where Y is grayscale value, R is R value, G is G value, and B is B value. 72 | 73 | This equation reflects the way of human visual perception. 74 | 75 | This grayscale conversion makes it difficult to restore hue of image. 76 | 77 | That's why we need Grayscale function, which just compute average of RGB channels. 78 | 79 | How to use these functions is shown below. 80 | 81 | ```{r} 82 | g <- Grayscale(boats) 83 | hueim <- GetHue(boats) 84 | g <- BalanceSimplest(g, s, s, range=c(0,1)) 85 | y <- RestoreHue(g, hueim) 86 | layout(matrix(1:2, 1, 2)) 87 | plot(boats, main = "Original") 88 | plot(y, main = "Processed While Preserving Hue") 89 | ``` 90 | 91 | Which way is better? 92 | 93 | It depends on your image and your purpose. 94 | 95 | You should consider which way is better when treating color images. -------------------------------------------------------------------------------- /src/iterative_triclass_thresholding.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Shota Ochi 3 | * All rights reserved. 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | #include 20 | 21 | // [[Rcpp::export]] 22 | Rcpp::NumericVector make_prob_otsu(Rcpp::NumericVector ordered, Rcpp::NumericVector bins, int intervalnumber, int width, int height) 23 | { 24 | Rcpp::NumericVector out(intervalnumber); 25 | int n = ordered.size(); 26 | int m = bins.size(); 27 | int count = 0; 28 | for (int i = 0; i < n; ++i) 29 | { 30 | if (ordered[i] <= bins[count]) 31 | { 32 | out[count] += 1; 33 | } else { 34 | while (ordered[i] > bins[count]) 35 | { 36 | ++count; 37 | } 38 | if (count >= intervalnumber || count >= m) 39 | { 40 | break; 41 | } 42 | out[count] += 1; 43 | } 44 | } 45 | double size = (double)width * height; 46 | for (int i = 0; i < intervalnumber; ++i) 47 | { 48 | out[i] /= size; 49 | } 50 | return out; 51 | } 52 | 53 | double calc_ICV_ostu(double omegak, double myuk, double myut) 54 | { 55 | if (omegak != 0 && omegak != 1) 56 | { 57 | return (myut * omegak - myuk) * (myut * omegak - myuk) / (omegak * (1 - omegak)); 58 | } else { 59 | return -1; 60 | } 61 | } 62 | 63 | // [[Rcpp::export]] 64 | double get_th_otsu(Rcpp::NumericVector prob_otsu, Rcpp::NumericVector bins) 65 | { 66 | int n = prob_otsu.size(); 67 | int m = bins.size(); 68 | if (n < 2) 69 | { 70 | Rcpp::Rcout << "lengths of prob_otsu must be greater than 1." << std::endl; 71 | return 0; 72 | } 73 | if (n != m) 74 | { 75 | Rcpp::Rcout << "lengths of prob_otsu and bins are not same." << std::endl; 76 | return 0; 77 | } 78 | 79 | double myut = 0.0; 80 | for (int i = 0; i < n; ++i) 81 | { 82 | myut += prob_otsu[i] * bins[i]; 83 | } 84 | 85 | double omegak = prob_otsu[0]; 86 | double myuk = prob_otsu[0] * bins[0]; 87 | double ICV = calc_ICV_ostu(omegak, myuk, myut); 88 | double maxICV = ICV; 89 | double threshold = bins[0]; 90 | for(int i = 1; i < n; ++i) 91 | { 92 | omegak += prob_otsu[i]; 93 | myuk += prob_otsu[i] * bins[i]; 94 | ICV = calc_ICV_ostu(omegak, myuk, myut); 95 | if (ICV > maxICV) 96 | { 97 | maxICV = ICV; 98 | threshold = bins[i]; 99 | } 100 | } 101 | return threshold; 102 | } -------------------------------------------------------------------------------- /R/fuzzy_thresholding.R: -------------------------------------------------------------------------------- 1 | #' Fuzzy Entropy Image Segmentation 2 | #' 3 | #' automatic fuzzy thresholding based on particle swarm optimization 4 | #' @param im a grayscale image of class cimg 5 | #' @param n swarm size 6 | #' @param maxiter maximum iterative time 7 | #' @param omegamax maximum inertia weight 8 | #' @param omegamin minimum inertia weight 9 | #' @param c1 acceleration coefficient 10 | #' @param c2 acceleration coefficient 11 | #' @param mutrate rate of gaussian mutation 12 | #' @param vmaxcoef coefficient of maximum velocity 13 | #' @param intervalnumber interval number of histogram 14 | #' @param returnvalue if returnvalue is TRUE, returns a threshold value. if FALSE, returns a pixel set. 15 | #' @return a pixel set or a numeric 16 | #' @references Linyi Li, Deren Li (2008). Fuzzy entropy image segmentation based on particle swarm optimization. Progress in Natural Science. 17 | #' @author Shota Ochi 18 | #' @export 19 | #' @examples 20 | #' g <- grayscale(boats) 21 | #' layout(matrix(1:2, 1, 2)) 22 | #' plot(g, main = "Original") 23 | #' ThresholdFuzzy(g) %>% plot(main = "Fuzzy Thresholding") 24 | ThresholdFuzzy <- function(im, n = 50, maxiter = 100, omegamax = 0.9, omegamin = 0.1, c1 = 2, c2 = 2, mutrate = 0.2, vmaxcoef = 0.1, intervalnumber = 1000, returnvalue = FALSE) 25 | { 26 | assert_im(im) 27 | assert_positive_numeric_one_elem(n) 28 | assert_positive_numeric_one_elem(maxiter) 29 | assert_positive_numeric_one_elem(omegamax) 30 | assert_positive_numeric_one_elem(omegamin) 31 | assert_positive_numeric_one_elem(c1) 32 | assert_positive_numeric_one_elem(c2) 33 | assert_positive_numeric_one_elem(mutrate) 34 | assert_positive_numeric_one_elem(vmaxcoef) 35 | assert_positive_numeric_one_elem(intervalnumber) 36 | assert_logical_one_elem(returnvalue) 37 | minval <- min(im) 38 | maxval <- max(im) 39 | if (n < 1) 40 | { 41 | stop("n must be greater than or equal to 1.") 42 | } 43 | if (omegamax >= 1) 44 | { 45 | stop("omegamax must be smaller than 1") 46 | } 47 | if (omegamin >= omegamax) 48 | { 49 | stop("omegamin must be smaller than omegamax") 50 | } 51 | if (maxiter < 2) 52 | { 53 | stop("maxiter must be greater than or equal to 2.") 54 | } 55 | if (intervalnumber < 2) 56 | { 57 | stop("intervalnumber must be greater than or equal to 2.") 58 | } 59 | if (minval == maxval) 60 | { 61 | stop("im has only one unique value. ThresholdFuzzy can't be applied for such a image.") 62 | } 63 | n <- as.integer(n) 64 | maxiter <- as.integer(maxiter) 65 | intervalnumber <- as.integer(intervalnumber) 66 | 67 | interval <- seq(minval, maxval, length.out = intervalnumber + 1) 68 | interval <- interval[2:length(interval)] 69 | vmax <- vmaxcoef * intervalnumber 70 | range_local_search <- as.integer(intervalnumber * 0.1 / 4) 71 | ordered <- as.vector(im) 72 | ordered <- ordered[order(ordered)] 73 | imhist <- make_histogram_fuzzy(ordered, interval) 74 | thresval <- fuzzy_threshold(imhist, interval, n, maxiter, omegamax, omegamin, c1, c2, mutrate, vmax, range_local_search) 75 | if (returnvalue) 76 | { 77 | return(thresval) 78 | } 79 | return(threshold(im, thresval)) 80 | } 81 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 2 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 3 | on: 4 | push: 5 | branches: 6 | - '**' 7 | pull_request: 8 | branches: 9 | - '**' 10 | 11 | name: R-CMD-check 12 | 13 | jobs: 14 | R-CMD-check: 15 | runs-on: ${{ matrix.config.os }} 16 | 17 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 18 | 19 | strategy: 20 | fail-fast: false 21 | matrix: 22 | config: 23 | - {os: windows-latest, r: 'release'} 24 | - {os: macOS-latest, r: 'release'} 25 | - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 26 | - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 27 | 28 | env: 29 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 30 | RSPM: ${{ matrix.config.rspm }} 31 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 32 | 33 | steps: 34 | - uses: actions/checkout@v3 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | 40 | - uses: r-lib/actions/setup-pandoc@v2 41 | 42 | - name: Install X11 dependencies on MacOS 43 | if: runner.os == 'macOS' 44 | run: | 45 | brew install --cask xquartz 46 | 47 | - name: Install System Requirements on Windows 48 | if: runner.os == 'Windows' 49 | run: | 50 | pacman -Sy --noconfirm mingw-w64-i686-fftw 51 | pacman -Sy --noconfirm mingw-w64-x86_64-fftw 52 | pacman -Sy --noconfirm mingw-w64-i686-libtiff 53 | pacman -Sy --noconfirm mingw-w64-x86_64-libtiff 54 | 55 | 56 | - name: Query dependencies 57 | run: | 58 | install.packages('remotes') 59 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 60 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 61 | shell: Rscript {0} 62 | 63 | - name: Cache R packages 64 | if: runner.os != 'Windows' 65 | uses: actions/cache@v2 66 | with: 67 | path: ${{ env.R_LIBS_USER }} 68 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 69 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 70 | 71 | - name: Install system dependencies 72 | if: runner.os == 'Linux' 73 | run: | 74 | while read -r cmd 75 | do 76 | eval sudo $cmd 77 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 78 | 79 | - name: Install dependencies 80 | run: | 81 | remotes::install_deps(dependencies = TRUE) 82 | remotes::install_cran("rcmdcheck") 83 | shell: Rscript {0} 84 | 85 | - name: Check 86 | env: 87 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 88 | run: | 89 | options(crayon.enabled = TRUE) 90 | rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") 91 | shell: Rscript {0} 92 | 93 | - name: Upload check results 94 | if: failure() 95 | uses: actions/upload-artifact@main 96 | with: 97 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 98 | path: check 99 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | DCTdenoising <- function(ipixelsR, width, height, sigma, flag_dct16x16) { 5 | .Call(`_imagerExtra_DCTdenoising`, ipixelsR, width, height, sigma, flag_dct16x16) 6 | } 7 | 8 | make_histogram_ADPHE <- function(ordered, interval) { 9 | .Call(`_imagerExtra_make_histogram_ADPHE`, ordered, interval) 10 | } 11 | 12 | find_local_maximum_ADPHE <- function(hist, n) { 13 | .Call(`_imagerExtra_find_local_maximum_ADPHE`, hist, n) 14 | } 15 | 16 | modify_histogram_ADPHE <- function(imhist, t_down, t_up) { 17 | .Call(`_imagerExtra_modify_histogram_ADPHE`, imhist, t_down, t_up) 18 | } 19 | 20 | histogram_equalization_ADPHE <- function(im, interval2, imhist_modified, min_range, max_range) { 21 | .Call(`_imagerExtra_histogram_equalization_ADPHE`, im, interval2, imhist_modified, min_range, max_range) 22 | } 23 | 24 | ChanVeseInitPhi <- function(Width, Height) { 25 | .Call(`_imagerExtra_ChanVeseInitPhi`, Width, Height) 26 | } 27 | 28 | ChanVeseInitPhi_Rect <- function(Width, Height, rect) { 29 | .Call(`_imagerExtra_ChanVeseInitPhi_Rect`, Width, Height, rect) 30 | } 31 | 32 | ChanVese <- function(im, Mu, Nu, Lambda1, Lambda2, tol, maxiter, dt, phi) { 33 | .Call(`_imagerExtra_ChanVese`, im, Mu, Nu, Lambda1, Lambda2, tol, maxiter, dt, phi) 34 | } 35 | 36 | DCT2D_reorder <- function(mat) { 37 | .Call(`_imagerExtra_DCT2D_reorder`, mat) 38 | } 39 | 40 | DCT2D_fromDFT <- function(mat) { 41 | .Call(`_imagerExtra_DCT2D_fromDFT`, mat) 42 | } 43 | 44 | IDCT2D_toDFT <- function(mat) { 45 | .Call(`_imagerExtra_IDCT2D_toDFT`, mat) 46 | } 47 | 48 | IDCT2D_retrievex <- function(mat) { 49 | .Call(`_imagerExtra_IDCT2D_retrievex`, mat) 50 | } 51 | 52 | make_histogram_fuzzy <- function(ordered, interval) { 53 | .Call(`_imagerExtra_make_histogram_fuzzy`, ordered, interval) 54 | } 55 | 56 | fuzzy_threshold <- function(imhist, interval, n, maxiter, omegamax, omegamin, c1, c2, mutrate, vmax, localsearch) { 57 | .Call(`_imagerExtra_fuzzy_threshold`, imhist, interval, n, maxiter, omegamax, omegamin, c1, c2, mutrate, vmax, localsearch) 58 | } 59 | 60 | make_prob_otsu <- function(ordered, bins, intervalnumber, width, height) { 61 | .Call(`_imagerExtra_make_prob_otsu`, ordered, bins, intervalnumber, width, height) 62 | } 63 | 64 | get_th_otsu <- function(prob_otsu, bins) { 65 | .Call(`_imagerExtra_get_th_otsu`, prob_otsu, bins) 66 | } 67 | 68 | threshold_adaptive <- function(mat, k, windowsize, maxsd) { 69 | .Call(`_imagerExtra_threshold_adaptive`, mat, k, windowsize, maxsd) 70 | } 71 | 72 | make_density_multilevel <- function(ordered, interval) { 73 | .Call(`_imagerExtra_make_density_multilevel`, ordered, interval) 74 | } 75 | 76 | make_integral_density_multilevel <- function(density) { 77 | .Call(`_imagerExtra_make_integral_density_multilevel`, density) 78 | } 79 | 80 | get_threshold_multilevel <- function(im_density, im_integral_density, n_thres, sn, mcn, limit) { 81 | .Call(`_imagerExtra_get_threshold_multilevel`, im_density, im_integral_density, n_thres, sn, mcn, limit) 82 | } 83 | 84 | threshold_multilevel <- function(im, thresvals) { 85 | .Call(`_imagerExtra_threshold_multilevel`, im, thresvals) 86 | } 87 | 88 | piecewise_transformation <- function(data, F, N, smax, smin, max, min, max_range, min_range) { 89 | .Call(`_imagerExtra_piecewise_transformation`, data, F, N, smax, smin, max, min, max_range, min_range) 90 | } 91 | 92 | screened_poisson_dct <- function(data, L) { 93 | .Call(`_imagerExtra_screened_poisson_dct`, data, L) 94 | } 95 | 96 | saturateim <- function(data, max_im, min_im, max_range, min_range) { 97 | .Call(`_imagerExtra_saturateim`, data, max_im, min_im, max_range, min_range) 98 | } 99 | 100 | -------------------------------------------------------------------------------- /R/chan_vese_segmentation.R: -------------------------------------------------------------------------------- 1 | #' Chan-Vese segmentation 2 | #' 3 | #' iterative image segmentation with Chan-Vese model 4 | #' @param im a grayscale image of class cimg 5 | #' @param mu length penalty 6 | #' @param nu area penalty 7 | #' @param lambda1 fit weight inside the curve 8 | #' @param lambda2 fit weight outside the curve 9 | #' @param tol convergence tolerance 10 | #' @param maxiter maximum number of iterations 11 | #' @param dt time step 12 | #' @param initial "interactive" or a grayscale image of class cimg. you can define initial condition as a rectangle shape interactively if initial is "interactive". If initial is a grayscale image of class cimg, pixels whose values are negative will be treated as outside of contour. pixels whose values are non-negative will be treated as inside of contour. checker board condition will be used if initial is not specified. 13 | #' @param returnstep a numeric vector that determines which result will be returned. 0 means initial condition, and 1 means the result after 1 iteration. final result will be returned if returnstep is not specified. 14 | #' @return a pixel set or a list of lists of numeric and pixel set 15 | #' @references Pascal Getreuer (2012). Chan-Vese Segmentation. Image Processing On Line 2, 214-224. 16 | #' @author Shota Ochi 17 | #' @export 18 | #' @examples 19 | #' layout(matrix(1:2, 1, 2)) 20 | #' g <- grayscale(dogs) 21 | #' plot(g, main = "Original") 22 | #' SegmentCV(g, lambda2 = 15) %>% plot(main = "Binarized") 23 | SegmentCV <- function(im, mu = 0.25, nu = 0.0, lambda1 = 1.0, lambda2 = 1.0, tol = 0.0001, maxiter = 500, dt = 0.5, initial, returnstep) 24 | { 25 | assert_im(im) 26 | assert_numeric_one_elem(mu) 27 | assert_numeric_one_elem(nu) 28 | assert_numeric_one_elem(lambda1) 29 | assert_numeric_one_elem(lambda2) 30 | assert_positive0_numeric_one_elem(tol) 31 | assert_positive_numeric_one_elem(maxiter) 32 | maxiter <- as.integer(maxiter) 33 | assert_positive_numeric_one_elem(dt) 34 | 35 | dim_im <- dim(im) 36 | if (missing(initial)) 37 | { 38 | initial <- ChanVeseInitPhi(dim_im[1], dim_im[2]) %>% as.cimg() 39 | } else if (!is.null(initial)) 40 | { 41 | if (is.character(initial)) 42 | { 43 | pos_rect <- grabRect(im) 44 | if (pos_rect[1] == pos_rect[3] && pos_rect[2] == pos_rect[4]) 45 | { 46 | stop("Specifying initial condition failed.") 47 | } 48 | initial <- ChanVeseInitPhi_Rect(dim_im[1], dim_im[2], pos_rect) %>% as.cimg() 49 | } else if (is.cimg(initial)) 50 | { 51 | dim_ini <- dim(initial) 52 | if (any(dim_ini != dim_im)) 53 | { 54 | stop("The dimension of initial is not same as dimension of im.") 55 | } 56 | } else 57 | { 58 | stop('initial must be "interactive" or a grayscale image of class cimg') 59 | } 60 | } 61 | 62 | if (missing(returnstep)) 63 | { 64 | res <- ChanVese(as.matrix(im), mu, nu, lambda1, lambda2, tol, maxiter, dt, as.matrix(initial)) 65 | if (res[[1]] == maxiter) 66 | { 67 | message("The computation stopped because the number of iteration reached maxiter.") 68 | } 69 | return(as.cimg(res[[2]]) >= 0) 70 | } else 71 | { 72 | assert_numeric_vec(returnstep) 73 | returnstep <- as.integer(returnstep) 74 | tmpidx_returnstep <- returnstep >= 0 && returnstep <= maxiter 75 | returnstep <- returnstep[tmpidx_returnstep] 76 | if (length(returnstep) < 1) 77 | { 78 | stop("The elements of returnstep must be in the range [0,maxiter].") 79 | } 80 | returnstep <- unique(returnstep) 81 | returnstep <- returnstep[order(returnstep)] 82 | returnstep2 <- c(0, returnstep) 83 | res <- list() 84 | if (returnstep[1] == 0) 85 | { 86 | result_first <- initial >= 0 87 | tmp0 <- list(num_iter = 0, result = result_first) 88 | res <- c(res, list(tmp0)) 89 | returnstep <- returnstep[2:length(returnstep)] 90 | } 91 | pre_phi <- as.matrix(initial) 92 | for (i in seq(length(returnstep))) 93 | { 94 | tmp_maxiter <- returnstep[i] - returnstep2[i] 95 | tmp_res <- ChanVese(as.matrix(im), mu, nu, lambda1, lambda2, tol, tmp_maxiter, dt, pre_phi) 96 | pre_phi <- tmp_res[[2]] 97 | tmp_res[[2]] <- as.cimg(tmp_res[[2]]) >= 0 98 | tmp_res[[1]] <- tmp_res[[1]] + returnstep2[i] 99 | res <- c(res, list(tmp_res)) 100 | if (tmp_res[[1]] != returnstep[i]) 101 | { 102 | message("The computation stopped in the middle because stop criterion was satisified") 103 | break 104 | } 105 | } 106 | return(res) 107 | } 108 | return(NULL) 109 | } 110 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | class_imager <- "cimg" 2 | 3 | assert_im <- function(im) 4 | { 5 | assert_class(im, class_imager) 6 | if (depth(im) != 1) 7 | { 8 | stop(sprintf("%s must be a grayscale image.", deparse(substitute(im)))) 9 | } 10 | if (spectrum(im) != 1) 11 | { 12 | stop(sprintf("%s must be a grayscale image.", deparse(substitute(im)))) 13 | } 14 | if (any(is.na(im))) 15 | { 16 | stop(sprintf("%s has NA. NA is unacceptable.", deparse(substitute(im)))) 17 | } 18 | } 19 | 20 | assert_imcol <- function(imcol) 21 | { 22 | assert_class(imcol, class_imager) 23 | if (depth(imcol) != 1) 24 | { 25 | stop(sprintf("%s must be an image of class cimg.", deparse(substitute(imcol)))) 26 | } 27 | if (spectrum(imcol) != 3) 28 | { 29 | stop(sprintf("%s number of color channels of imcol must be 3.", deparse(substitute(imcol)))) 30 | } 31 | if (any(is.na(imcol))) 32 | { 33 | stop(sprintf("%s has NA. NA is unacceptable.", deparse(substitute(imcol)))) 34 | } 35 | } 36 | 37 | assert_range <- function(range) 38 | { 39 | assert_numeric(range, lower = 0, finite = TRUE, any.missing = FALSE, sorted = TRUE, len = 2, .var.name = deparse(substitute(range))) 40 | } 41 | 42 | assert_positive_numeric_one_elem <- function(mynumeric) 43 | { 44 | assert_numeric(mynumeric, finite = TRUE, any.missing = FALSE, len = 1, .var.name = deparse(substitute(mynumeric))) 45 | if (mynumeric <= 0) 46 | { 47 | stop(sprintf("%s must be greater than 0.", deparse(substitute(mynumeric)))) 48 | } 49 | } 50 | 51 | assert_positive0_numeric_one_elem <- function(mynumeric) 52 | { 53 | assert_numeric(mynumeric, lower = 0, finite = TRUE, any.missing = FALSE, len = 1, .var.name = deparse(substitute(mynumeric))) 54 | } 55 | 56 | assert_numeric_one_elem <- function(mynumeric) 57 | { 58 | assert_numeric(mynumeric, finite = TRUE, any.missing = FALSE, len = 1, .var.name = deparse(substitute(mynumeric))) 59 | } 60 | 61 | assert_numeric_vec <- function(numericvec) 62 | { 63 | assert_numeric(numericvec, finite = TRUE, any.missing = FALSE, min.len = 1, .var.name = deparse(substitute(numericvec))) 64 | } 65 | 66 | assert_logical_one_elem <- function(mylogical) 67 | { 68 | assert_logical(mylogical, any.missing = FALSE, len = 1, .var.name = deparse(substitute(mylogical))) 69 | } 70 | 71 | assert_im_mat <- function(imormat) 72 | { 73 | assert(check_class(imormat, class_imager), check_class(imormat, "matrix"), .var.name = deparse(substitute(imormat))) 74 | if (any(class(imormat) == class_imager)) 75 | { 76 | assert_im(imormat) 77 | } else 78 | { 79 | assert(check_matrix(imormat, mode = "numeric", any.missing = FALSE), 80 | check_matrix(imormat, mode = "double", any.missing = FALSE), 81 | check_matrix(imormat, mode = "integer", any.missing = FALSE), 82 | .var.name = deparse(substitute(imormat))) 83 | } 84 | } 85 | 86 | assert_im_px <- function(imorpx) 87 | { 88 | assert(check_class(imorpx, class_imager), check_class(imorpx, "pixset"), .var.name = deparse(substitute(imorpx))) 89 | imorpx <- as.cimg(imorpx) 90 | if (spectrum(imorpx) == 1) 91 | { 92 | assert_im(imorpx) 93 | } else 94 | { 95 | assert_imcol(imorpx) 96 | } 97 | } 98 | 99 | #$' Convert string to numeric as percentile 100 | #$' 101 | #$' @param s_input string that means a percentile 102 | #$' @return numeric that means a percentile 103 | #$' @examples 104 | #$' convert_percentile("1%") # return 1 105 | convert_percentile <- function(s_input) 106 | { 107 | splitted <- strsplit(s_input , "%") 108 | candidate <- suppressWarnings(as.numeric(splitted[[1]][1])) 109 | if (!test_numeric(candidate, lower = 0, finite = TRUE, any.missing = FALSE, len = 1)) 110 | { 111 | stop("saturation percentage parameter (s, sleft, or sright) is not appropriate.") 112 | } 113 | return(candidate) 114 | } 115 | 116 | assert_s <- function(s_input) 117 | { 118 | assert(check_character(s_input, min.chars = 1, any.missing = FALSE, len = 1), check_numeric(s_input, lower = 0, finite = TRUE, len = 1), .var.name = deparse(substitute(s_input))) 119 | if (!is.numeric(s_input)) 120 | { 121 | s_input <- convert_percentile(s_input) 122 | } 123 | return(s_input) 124 | } 125 | 126 | assert_s_left_right <- function(sleft, sright) 127 | { 128 | if (sleft + sright > 100) 129 | { 130 | stop("Saturation parameters (s, sleft, or sright) are too large. Confirm the following condition is satisfied. s <= 50 or sleft + sright <= 100.") 131 | } 132 | } 133 | 134 | assert_char <- function(mychar) 135 | { 136 | assert_character(mychar, min.chars = 1, any.missing = FALSE, len = 1, .var.name = deparse(substitute(s_input))) 137 | } 138 | -------------------------------------------------------------------------------- /R/iterative_triclass_thresholding.R: -------------------------------------------------------------------------------- 1 | #$' Otsu method 2 | #$' 3 | #$' compute threshold value by Otsu method 4 | #$' @param im a grayscale image of class cimg 5 | #$' @param intervalnumber interval number of histogram 6 | #$' @return double 7 | #$' @references Nobuyuki Otsu (1979) A threshold selection method from gray-level histograms. IEEE. 8 | #$' @author Shota Ochi 9 | #threshold_otsu <- function(im, intervalnumber = 1000) 10 | #{ 11 | #dimim <- dim(im) 12 | #ordered <- as.vector(im) 13 | #ordered <- ordered[order(ordered)] 14 | #minim <- ordered[1] 15 | #maxim <- ordered[length(ordered)] 16 | #bins <- seq(minim, maxim, length.out = intervalnumber + 1) 17 | #prob_otsu <- make_prob_otsu(ordered, bins, intervalnumber, dimim[1], dimim[2]) 18 | #thresval <- get_th_otsu(prob_otsu, bins) 19 | #return(thresval) 20 | #} 21 | 22 | #' Iterative Triclass Thresholding 23 | #' 24 | #' compute threshold value by Iterative Triclass Threshold Technique 25 | #' @param im a grayscale image of class cimg 26 | #' @param stopval value to determine whether stop iteration of triclass thresholding or not. Note that if repeat is set, stop is ignored. 27 | #' @param repeatnum number of repetition of triclass thresholding 28 | #' @param intervalnumber interval number of histogram 29 | #' @param returnvalue if returnvalue is TRUE, ThresholdTriclass returns threshold value. if FALSE, ThresholdTriclass returns pixset. 30 | #' @return a pixel set or a numeric 31 | #' @references Cai HM, Yang Z, Cao XH, Xia WM, Xu XY (2014). A New Iterative Triclass Thresholding Technique in Image Segmentation. IEEE TRANSACTIONS ON IMAGE PROCESSING. 32 | #' @author Shota Ochi 33 | #' @export 34 | #' @examples 35 | #' g <- grayscale(boats) 36 | #' layout(matrix(1:4, 2, 2)) 37 | #' plot(boats, main = "Original") 38 | #' plot(g, main = "Grayscale") 39 | #' threshold(g) %>% plot(main = "A Variant of Otsu") 40 | #' ThresholdTriclass(g) %>% plot(main = "Triclass") 41 | ThresholdTriclass <- function(im, stopval = 0.01, repeatnum, intervalnumber = 1000, returnvalue = FALSE) 42 | { 43 | assert_im(im) 44 | assert_positive_numeric_one_elem(intervalnumber) 45 | assert_logical_one_elem(returnvalue) 46 | minim <- min(im) 47 | maxim <- max(im) 48 | if (minim == maxim) 49 | { 50 | stop("im has only one unique value. ThresholdTriclass can't be applied for such a image.", call. = FALSE) 51 | } 52 | 53 | if (missing(repeatnum)) 54 | { 55 | assert_positive_numeric_one_elem(stopval) 56 | dimim <- dim(im) 57 | ordered <- as.vector(im) 58 | ordered <- ordered[order(ordered)] 59 | bins <- seq(minim, maxim, length.out = intervalnumber + 1) 60 | prob_otsu <- make_prob_otsu(ordered, bins[2:length(bins)], as.integer(intervalnumber), dimim[1], dimim[2]) 61 | bins <- (bins[2:length(bins)] + bins[1:(length(bins)-1)]) / 2 62 | thresval <- get_th_otsu(prob_otsu, bins) 63 | thresval_pre <- thresval + 2 * stopval 64 | while (TRUE) 65 | { 66 | indexf <- ordered > thresval 67 | indexb <- !indexf 68 | myu1 <- mean(ordered[indexf]) 69 | myu0 <- mean(ordered[indexb]) 70 | ordered <- ordered[ordered >= myu0 & ordered <= myu1] 71 | if (is.nan(myu0) || is.nan(myu1)) 72 | { 73 | break 74 | } 75 | indexTBD <- bins >= myu0 & bins <= myu1 76 | bins <- bins[indexTBD] 77 | prob_otsu <- prob_otsu[indexTBD] 78 | if (sum(prob_otsu) == 0 || length(prob_otsu) < 2) 79 | { 80 | break 81 | } 82 | prob_otsu <- prob_otsu / sum(prob_otsu) 83 | thresval <- get_th_otsu(prob_otsu, bins) 84 | if (abs(thresval - thresval_pre) < stopval) 85 | { 86 | break 87 | } 88 | thresval_pre <- thresval 89 | } 90 | } else { 91 | assert_positive_numeric_one_elem(repeatnum) 92 | if (repeatnum < 1) 93 | { 94 | stop("repeatnum must be greater than or equal to 1.") 95 | } 96 | dimim <- dim(im) 97 | ordered <- as.vector(im) 98 | ordered <- ordered[order(ordered)] 99 | bins <- seq(minim, maxim, length.out = intervalnumber + 1) 100 | prob_otsu <- make_prob_otsu(ordered, bins[2:length(bins)], intervalnumber, dimim[1], dimim[2]) 101 | bins <- (bins[2:length(bins)] + bins[1:(length(bins)-1)]) / 2 102 | thresval <- get_th_otsu(prob_otsu, bins) 103 | for (i in seq_len(as.integer(repeatnum) - 1)) 104 | { 105 | indexf <- ordered > thresval 106 | indexb <- !indexf 107 | myu1 <- mean(ordered[indexf]) 108 | myu0 <- mean(ordered[indexb]) 109 | ordered <- ordered[ordered >= myu0 & ordered <= myu1] 110 | if (is.nan(myu0) || is.nan(myu1)) 111 | { 112 | message("Iteration was stopped in the middle.") 113 | break 114 | } 115 | indexTBD <- bins >= myu0 & bins <= myu1 116 | bins <- bins[indexTBD] 117 | prob_otsu <- prob_otsu[indexTBD] 118 | if (sum(prob_otsu) == 0 || length(prob_otsu) < 2) 119 | { 120 | message("Iteration was stopped in the middle.") 121 | break 122 | } 123 | prob_otsu <- prob_otsu / sum(prob_otsu) 124 | thresval <- get_th_otsu(prob_otsu, bins) 125 | } 126 | } 127 | if (returnvalue) 128 | { 129 | return(thresval) 130 | } 131 | return(threshold(im, thresval)) 132 | } 133 | -------------------------------------------------------------------------------- /R/multilevel_thresholding.R: -------------------------------------------------------------------------------- 1 | #$' Automatic Multilevel Thresholding (Maximum Entropy Based Artificial Bee Colony Thresholding) 2 | #$' 3 | #$' automatic multilevel thresholding based on Maximum Entropy Based Artificial Bee Colony Thresholding 4 | #$' @param im a grayscale image of class cimg 5 | #$' @param k level of thresholding 6 | #$' @param sn population size 7 | #$' @param mcn maximum cycle number 8 | #$' @param limit abandonment criteria 9 | #$' @param intervalnumber interval number of histogram 10 | #$' @param returnvalue if returnvalue is TRUE, returns threshold values. if FALSE, returns a grayscale image of class cimg. 11 | #$' @return a grayscale image of class cimg or a numeric vector 12 | #$' @references Ming-HuwiHorng (2011). Multilevel thresholding selection based on the artificial bee colony algorithm for image segmentation. Expert Systems with Applications. 13 | #$' @author Shota Ochi 14 | #$' @examples 15 | #$' g <- grayscale(boats) 16 | #$' ThresholdML(g, 2) %>% plot 17 | ThresholdML_MEABCT <- function(im, k, sn = 30, mcn = 100, limit = 100, intervalnumber = 1000, returnvalue = FALSE) 18 | { 19 | assert_im(im) 20 | assert_positive_numeric_one_elem(k) 21 | assert_positive_numeric_one_elem(sn) 22 | assert_positive_numeric_one_elem(mcn) 23 | assert_positive_numeric_one_elem(limit) 24 | assert_positive_numeric_one_elem(intervalnumber) 25 | assert_logical_one_elem(returnvalue) 26 | minval <- min(im) 27 | maxval <- max(im) 28 | if (k < 1) 29 | { 30 | stop("k must be greater than or equal to 1.") 31 | } 32 | if (sn < 2) 33 | { 34 | stop("sn must be greater than or equal to 2.") 35 | } 36 | if (mcn < 1) 37 | { 38 | stop("mcn must be greater than or equal to 1.") 39 | } 40 | if (limit < 1) 41 | { 42 | stop("limit must be greater than or equal to 1.") 43 | } 44 | if (intervalnumber < 2) 45 | { 46 | stop("intervalnumber must be greater than or equal to 2.") 47 | } 48 | if (minval == maxval) 49 | { 50 | stop("im has only one unique value. ThresholdML can't be applied for such a image.") 51 | } 52 | intervalnumber <- as.integer(intervalnumber) 53 | interval <- seq(minval, maxval, length.out = intervalnumber + 1) 54 | ordered <- as.vector(im) 55 | ordered <- ordered[order(ordered)] 56 | im_density <- make_density_multilevel(ordered, interval[2:length(interval)]) 57 | im_integral_density <- make_integral_density_multilevel(im_density) 58 | idx_thresvals <- get_threshold_multilevel(im_density, im_integral_density, as.integer(k), as.integer(sn), as.integer(mcn), as.integer(limit)) 59 | interval <- (interval[1:length(interval)-1] + interval[2:length(interval)]) / 2 60 | thresvals <- interval[idx_thresvals] 61 | if (returnvalue) 62 | { 63 | return(thresvals) 64 | } 65 | return(as.cimg(threshold_multilevel(as.matrix(im), thresvals))) 66 | } 67 | 68 | #' Multilevel Thresholding 69 | #' 70 | #' Segments a grayscale image into several gray levels. 71 | #' Multilevel thresholding selection based on the artificial bee colony algorithm is used when thr is not a numeric vector. Preset parameters for fast computing is used when thr is "fast". Preset parameters for precise computing is used when thr is "precise". You can tune the parameters if thr is "manual". 72 | #' Also you can specify the values of thresholds by setting thr as a numeric vector. 73 | #' @param im a grayscale image of class cimg 74 | #' @param k level of thresholding. k is ignored when thr is a numeric vector. 75 | #' @param thr thresholds, either numeric vector, or "fast", or "precise", or "manual". 76 | #' @param sn population size. sn is ignored except when thr is "manual". 77 | #' @param mcn maximum cycle number. mcn is ignored except when thr is "manual". 78 | #' @param limit abandonment criteria. limit is ignored except when thr is "manual". 79 | #' @param intervalnumber interval number of histogram. intervalnumber is ignored except when thr is "manual". 80 | #' @param returnvalue if returnvalue is TRUE, returns threshold values. if FALSE, returns a grayscale image of class cimg. 81 | #' @return a grayscale image of class cimg or a numeric vector 82 | #' @references Ming-HuwiHorng (2011). Multilevel thresholding selection based on the artificial bee colony algorithm for image segmentation. Expert Systems with Applications. 83 | #' @author Shota Ochi 84 | #' @export 85 | #' @examples 86 | #' g <- grayscale(boats) 87 | #' ThresholdML(g, k = 2) %>% plot 88 | ThresholdML <- function(im, k, thr = "fast", sn = 30, mcn = 100, limit = 100, intervalnumber = 1000, returnvalue = FALSE) 89 | { 90 | res <- NULL 91 | assert_im(im) 92 | if (is.character(thr)) 93 | { 94 | assert_char(thr) 95 | if (thr == "fast") 96 | { 97 | res <- ThresholdML_MEABCT(im, k, 30, 100, 100, 1000, returnvalue) 98 | } else if (thr == "precise") 99 | { 100 | res <- ThresholdML_MEABCT(im, k, 100, 200, 10, 2000, returnvalue) 101 | } else if (thr == "manual") 102 | { 103 | res <- ThresholdML_MEABCT(im, k, sn, mcn, limit, intervalnumber, returnvalue) 104 | } else 105 | { 106 | stop("thr must be a numeric vector, or 'fast', or 'precise', or 'manual'.") 107 | } 108 | } else 109 | { 110 | assert_numeric_vec(thr) 111 | ordered <- thr[order(thr)] 112 | if (any(ordered != thr)) 113 | { 114 | warning("thr was arranged in ascending order.") 115 | } 116 | if (returnvalue) 117 | { 118 | return(ordered) 119 | } 120 | res <- as.cimg(threshold_multilevel(as.matrix(im), ordered)) 121 | } 122 | return(res) 123 | } 124 | -------------------------------------------------------------------------------- /src/piecewise_equalization.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2011 Catalina Sbert 3 | * All rights reserved 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | #include 20 | 21 | /** 22 | * @brief inverse cumulative distribution function 23 | * 24 | * Given a value Fu, computes the inverse of the cumulative histogram 25 | * by searching the appropriate value in the array of sorted data 26 | * 27 | * @param Fu value (> 0) 28 | * @param F sorted data 29 | * @return x the inverse value of Fu 30 | */ 31 | double inverse_cumulative_function(double Fu, Rcpp::NumericVector F) 32 | { 33 | double x; 34 | int pos; 35 | 36 | /* sanity check*/ 37 | if (Fu < 0) 38 | { 39 | Rcpp::Rcout << "Error: Fu is lower than 0 (Fu: " << Fu << ")" << std::endl; 40 | return 0; 41 | } 42 | 43 | pos = (int) ceil((double) Fu); 44 | pos = pos - 1; /*array indexes start at 0*/ 45 | 46 | x = F[pos]; 47 | 48 | return x; 49 | } 50 | 51 | /** 52 | * @brief Affine Transformation 53 | * 54 | * This function is the affine transformation of the interval [x0,x1] into 55 | * [y0,y1] 56 | * 57 | * @param data input array 58 | * @param x0, x1 initial interval 59 | * @param y0, y1 transformed interval 60 | 61 | @return data_out output array 62 | */ 63 | void affine_transformation(Rcpp::NumericVector data, int n, double* ptr_data_out, double x0, double x1, double y0, double y1, double max_range, double min_range) 64 | { 65 | double slope; 66 | 67 | slope = (y1 - y0) / (x1 - x0); 68 | 69 | for (int i = 0; i < n; ++i) 70 | { 71 | if (x0 <= data[i] && data[i] <= x1) 72 | { 73 | ptr_data_out[i] = y0 + slope * (data[i] - x0); 74 | if (ptr_data_out[i] > max_range) 75 | { 76 | ptr_data_out[i] = max_range; 77 | } 78 | if (ptr_data_out[i] < min_range) 79 | { 80 | ptr_data_out[i] = min_range; 81 | } 82 | } 83 | } 84 | } 85 | 86 | /** 87 | * @brief Main block of the algorithm 88 | * 89 | * Given a regular partition of [0,255] with N {y_k} control points 90 | * (N=number of intervals of the partition - 1), compute a new partition 91 | * as the inverse of the cumulative histogram of the initial data {x_k}. 92 | * 93 | * Then apply an affine transform which transforms [x_{k-1}, x_k] into 94 | * [y_{k-1}, y_k]. The slope of this application is s_k. 95 | * We impose a constraint on the slope for this affine transform 96 | * 97 | * @f$ m_k=\cases{max(s_k, smin) & if $s_k <1$ \cr min(s_k, smax) & if $s_k >1$\cr} \f$ 98 | * 99 | * @param data initial array 100 | * @param F sorted initial array 101 | * @param dim size of the array 102 | * @param N number of control points (number of intervals of the partition - 1) 103 | * @param smax maximum slope allowed 104 | * @param smin minimum slope allowed 105 | * @param min minimum of initial array 106 | * @param max maximum of initial array 107 | * @param max_range maximum of the range of the value 108 | * @param min_range minimum of the range of the value 109 | * transformation 110 | * 111 | */ 112 | // [[Rcpp::export]] 113 | Rcpp::NumericVector piecewise_transformation(Rcpp::NumericVector data, Rcpp::NumericVector F, int N, double smax, double smin, double max, double min, double max_range, double min_range) 114 | { 115 | double x0, x1, y0, y1; 116 | double Fu; 117 | int k; 118 | double slope; 119 | 120 | int n = data.size(); 121 | Rcpp::NumericVector data_out(n); 122 | data_out.fill(0.0); 123 | double* ptr_data_out = data_out.begin(); 124 | 125 | x0 = min; 126 | y0 = min_range; 127 | 128 | for (k = 1; k <= N; k++) 129 | { 130 | Fu = (double) k * n / (double) (N + 1); 131 | y1 = (max_range * (double) k) / (double) (N + 1); 132 | x1 = inverse_cumulative_function(Fu, F); 133 | if (x1 > x0) 134 | { 135 | slope = (y1 - y0) / (x1 - x0); 136 | 137 | if (slope > smax) 138 | { 139 | y1 = smax * (x1 - x0) + y0; 140 | } 141 | if (slope < smin) 142 | { 143 | y1 = smin * (x1 - x0) + y0; 144 | } 145 | affine_transformation(data, n, ptr_data_out, x0, x1, y0, y1, max_range, min_range); 146 | x0 = x1; 147 | y0 = y1; 148 | } 149 | } 150 | if (x0 < max) 151 | { 152 | y1 = max_range; 153 | x1 = max; 154 | slope = (y1 - y0) / (x1 - x0); 155 | if (slope > smax) 156 | { 157 | y1 = smax * (x1 - x0) + y0; 158 | } 159 | if (slope < smin) 160 | { 161 | y1 = smin * (x1 - x0) + y0; 162 | } 163 | affine_transformation(data, n, ptr_data_out, x0, x1, y0, y1, max_range, min_range); 164 | } 165 | 166 | return data_out; 167 | } -------------------------------------------------------------------------------- /R/adaptive_double_plateaus_histogram_equalization.R: -------------------------------------------------------------------------------- 1 | #' Double Plateaus Histogram Equalization 2 | #' 3 | #' enhances contrast of image by double plateaus histogram equalization. 4 | #' @param im a grayscale image of class cimg 5 | #' @param t_down lower threshold 6 | #' @param t_up upper threshold 7 | #' @param N the number of subintervals of histogram 8 | #' @param range range of the pixel values of image. this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1]. 9 | #' @return a grayscale image of class cimg 10 | #' @references Kun Liang, Yong Ma, Yue Xie, Bo Zhou ,Rui Wang (2012). A new adaptive contrast enhancement algorithm for infrared images based on double plateaus histogram equalization. Infrared Phys. Technol. 55, 309-315. 11 | #' @author Shota Ochi 12 | #' @export 13 | #' @examples 14 | #' g <- grayscale(dogs) 15 | #' layout(matrix(1:2, 1, 2)) 16 | #' plot(g, main = "Original") 17 | #' EqualizeDP(g, 20, 186) %>% plot(main = "Contrast Enhanced") 18 | EqualizeDP <- function(im, t_down, t_up, N = 1000, range = c(0,255)) 19 | { 20 | assert_im(im) 21 | assert_range(range) 22 | assert_numeric_one_elem(t_down) 23 | assert_numeric_one_elem(t_up) 24 | if (t_down > t_up) 25 | { 26 | stop("t_down is bigger than t_up.") 27 | } 28 | assert_positive_numeric_one_elem(N) 29 | if (N < 2) 30 | { 31 | stop("N must be greater than or equal to 2.") 32 | } 33 | 34 | dim_im <- dim(im) 35 | minval <- min(im) 36 | maxval <- max(im) 37 | if (minval == maxval) 38 | { 39 | stop("im has only one unique value. EqualizeDP can't be applied for such a image.") 40 | } 41 | N <- as.integer(N) 42 | interval <- seq(minval, maxval, length.out = N + 1) 43 | interval1 <- interval[1:(length(interval)-1)] 44 | interval2 <- interval[2:length(interval)] 45 | ordered <- as.vector(im) 46 | ordered <- ordered[order(ordered)] 47 | imhist <- make_histogram_ADPHE(ordered, interval2) 48 | imhist_modified <- modify_histogram_ADPHE(imhist, t_down, t_up) 49 | res <- histogram_equalization_ADPHE(as.matrix(im), interval2, imhist_modified, range[1], range[2]) 50 | return(as.cimg(res)) 51 | } 52 | 53 | #' Adaptive Double Plateaus Histogram Equalization 54 | #' 55 | #' computes the parameters, t_down and t_up, and then apply double plateaus histogram equalization. 56 | #' @param im a grayscale image of class cimg 57 | #' @param n window size to determine local maximum 58 | #' @param N the number of subintervals of histogram 59 | #' @param range range of the pixel values of image. this function assumes that the range of pixel values of of an input image is [0,255] by default. you may prefer [0,1]. 60 | #' @param returnparam if returnparam is TRUE, returns the computed parameters: t_down and t_up. 61 | #' @return a grayscale image of class cimg or a numericvector 62 | #' @references Kun Liang, Yong Ma, Yue Xie, Bo Zhou ,Rui Wang (2012). A new adaptive contrast enhancement algorithm for infrared images based on double plateaus histogram equalization. Infrared Phys. Technol. 55, 309-315. 63 | #' @author Shota Ochi 64 | #' @export 65 | #' @examples 66 | #' g <- grayscale(dogs) 67 | #' layout(matrix(1:2, 1, 2)) 68 | #' plot(g, main = "Original") 69 | #' EqualizeADP(g) %>% plot(main = "Contrast Enhanced") 70 | EqualizeADP <- function(im, n = 5, N = 1000, range = c(0,255), returnparam = FALSE) 71 | { 72 | assert_im(im) 73 | assert_range(range) 74 | assert_logical_one_elem(returnparam) 75 | assert_positive_numeric_one_elem(n) 76 | if (as.integer(n) %% 2 != 1) 77 | { 78 | warning(sprintf("n is %d. n will be used as %d because n must be odd.", n, as.integer(n - 1))) 79 | n <- n - 1 80 | } 81 | n <- as.integer(n) 82 | if (n < 3) 83 | { 84 | stop("n must be greater than or equal to 3.") 85 | } 86 | assert_positive_numeric_one_elem(N) 87 | if (N < 2) 88 | { 89 | stop("N must be greater than or equal to 2.") 90 | } 91 | N <- as.integer(N) 92 | 93 | dim_im <- dim(im) 94 | minval <- min(im) 95 | maxval <- max(im) 96 | if (minval == maxval) 97 | { 98 | stop("im has only one unique value. EqualizeADP can't be applied for such a image.") 99 | } 100 | interval <- seq(minval, maxval, length.out = N + 1) 101 | interval1 <- interval[1:(length(interval)-1)] 102 | interval2 <- interval[2:length(interval)] 103 | ordered <- as.vector(im) 104 | ordered <- ordered[order(ordered)] 105 | imhist <- make_histogram_ADPHE(ordered, interval2) 106 | idx_imhist_not0 <- imhist != 0 107 | imhist_not0 <- imhist[idx_imhist_not0] 108 | local_maxima <- find_local_maximum_ADPHE(imhist_not0, n) 109 | if (length(local_maxima) == 0) 110 | { 111 | warning("There is no local maximum in the histogram with zero statistics removed.\nTry to decrease n or increase N.") 112 | if (returnparam) 113 | { 114 | return(c(t_down = NA, t_up = NA)) 115 | } else 116 | { 117 | return(im) 118 | } 119 | } 120 | t_up <- mean(local_maxima) 121 | d_min <- (range[2] - range[1]) / N #minimum gray level interval in modified histogram 122 | n_total <- dim_im[1] * dim_im[2] 123 | L <- length(imhist_not0) 124 | Sta <- min(n_total, t_up * L) 125 | M <- N 126 | t_down <- d_min * Sta / M 127 | if (t_down > t_up) 128 | { 129 | tmp_param <- t_up 130 | t_up <- t_down 131 | t_down <- tmp_param 132 | } 133 | if (returnparam) 134 | { 135 | return(c(t_down = t_down, t_up = t_up)) 136 | } 137 | imhist_modified <- modify_histogram_ADPHE(imhist, t_down, t_up) 138 | res <- histogram_equalization_ADPHE(as.matrix(im), interval2, imhist_modified, range[1], range[2]) 139 | return(as.cimg(res)) 140 | } 141 | -------------------------------------------------------------------------------- /src/fast_discrete_cosine_transoformation.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Shota Ochi 3 | * All rights reserved. 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | //$ reference: Makhoul, J. (1980). A fast cosine transform in one and two dimensions. IEEE Transactions on Acoustics, Speech, and Signal Processing. 28 (1): 27-34. 20 | 21 | #include 22 | 23 | // [[Rcpp::export]] 24 | Rcpp::NumericMatrix DCT2D_reorder(Rcpp::NumericMatrix mat) { 25 | int nrow = mat.nrow(); 26 | int ncol = mat.ncol(); 27 | Rcpp::NumericMatrix res(nrow, ncol); 28 | 29 | int nrowp1_half = (nrow + 1) / 2; 30 | int ncolp1_half = (ncol + 1) / 2; 31 | for (int i = 0; i < nrowp1_half; ++i) { 32 | for (int j = 0; j < ncolp1_half; ++j) { 33 | res(i,j) = mat(2*i, 2*j); 34 | } 35 | for (int j = ncolp1_half; j < ncol; ++j) { 36 | res(i,j) = mat(2*i, 2*ncol-2*j-1); 37 | } 38 | } 39 | for (int i = nrowp1_half; i < nrow; ++i) { 40 | for (int j = 0; j < ncolp1_half; ++j) { 41 | res(i,j) = mat(2*nrow-2*i-1, 2*j); 42 | } 43 | for (int j = ncolp1_half; j < ncol; ++j) { 44 | res(i,j) = mat(2*nrow-2*i-1, 2*ncol-2*j-1); 45 | } 46 | } 47 | return res; 48 | } 49 | 50 | Rcomplex calc_wm(int k, double m) { 51 | double coef = -2 * M_PI * k / m; 52 | Rcomplex res; 53 | res.r = cos(coef); 54 | res.i = sin(coef); 55 | return res; 56 | } 57 | 58 | //$' calculate DCT2D from DFT2D 59 | // [[Rcpp::export]] 60 | Rcpp::NumericMatrix DCT2D_fromDFT(Rcpp::ComplexMatrix mat) { 61 | int nrow = mat.nrow(); 62 | int ncol = mat.ncol(); 63 | double nrow4 = 4.0 * nrow; 64 | double ncol4 = 4.0 * ncol; 65 | Rcpp::NumericMatrix res(nrow, ncol); 66 | 67 | for (int j = 0; j < ncol; ++j) { 68 | int i = 0; 69 | Rcomplex wk14N1 = calc_wm(i, nrow4); 70 | Rcomplex wk24N2 = calc_wm(j, ncol4); 71 | Rcomplex temp = wk14N1 * (wk24N2 * mat(i,j)); 72 | res(i,j) = temp.r; 73 | } 74 | for (int i = 1; i < nrow; ++i) { 75 | Rcomplex wk14N1 = calc_wm(i, nrow4); 76 | int j = 0; 77 | Rcomplex wk24N2 = calc_wm(j, ncol4); 78 | Rcomplex temp = wk14N1 * (wk24N2 * mat(i,j)); 79 | res(i,j) = temp.r; 80 | } 81 | for (int i = 1; i < nrow; ++i) { 82 | Rcomplex wk14N1 = calc_wm(i, nrow4); 83 | for (int j = 1; j < ncol; ++j) { 84 | Rcomplex wk24N2 = calc_wm(j, ncol4); 85 | Rcomplex wmik24N2 = calc_wm(-j, ncol4); 86 | Rcomplex temp = wk14N1 * (wk24N2 * mat(i,j) + wmik24N2 * mat(i,ncol-j)); 87 | res(i,j) = temp.r * 0.5; 88 | } 89 | } 90 | return res; 91 | } 92 | 93 | //$' calculate DFT2D from DCT2D 94 | // [[Rcpp::export]] 95 | Rcpp::ComplexMatrix IDCT2D_toDFT(Rcpp::NumericMatrix mat) { 96 | int nrow = mat.nrow(); 97 | int ncol = mat.ncol(); 98 | double nrow4 = 4.0 * nrow; 99 | double ncol4 = 4.0 * ncol; 100 | Rcpp::ComplexMatrix res(nrow, ncol); 101 | 102 | res(0,0).r = mat(0,0); 103 | res(0,0).i = 0.0; 104 | for (int i = 1; i < nrow; ++i) { 105 | int j = 0; 106 | Rcomplex wmik14N1 = calc_wm(-i, nrow4); 107 | Rcomplex wmik24N2 = calc_wm(-j, ncol4); 108 | Rcomplex temp; 109 | temp.r = mat(i,j); 110 | temp.i = -mat(nrow-i,j); 111 | Rcomplex temp2 = wmik14N1 * wmik24N2 * temp; 112 | res(i,j).r = temp2.r; 113 | res(i,j).i = temp2.i; 114 | } 115 | for (int j = 1; j < ncol; ++j) { 116 | int i = 0; 117 | Rcomplex wmik14N1 = calc_wm(-i, nrow4); 118 | Rcomplex wmik24N2 = calc_wm(-j, ncol4); 119 | Rcomplex temp; 120 | temp.r = mat(i,j); 121 | temp.i = -mat(i,ncol-j); 122 | Rcomplex temp2 = wmik14N1 * wmik24N2 * temp; 123 | res(i,j).r = temp2.r; 124 | res(i,j).i = temp2.i; 125 | } 126 | for (int i = 1; i < nrow; ++i) { 127 | Rcomplex wmik14N1 = calc_wm(-i, nrow4); 128 | for (int j = 1; j < ncol; ++j) { 129 | Rcomplex wmik24N2 = calc_wm(-j, ncol4); 130 | Rcomplex temp; 131 | temp.r = mat(i,j) - mat(nrow-i,ncol-j); 132 | temp.i = -(mat(nrow-i,j) + mat(i,ncol-j)); 133 | Rcomplex temp2 = wmik14N1 * wmik24N2 * temp; 134 | res(i,j).r = temp2.r; 135 | res(i,j).i = temp2.i; 136 | } 137 | } 138 | 139 | return res; 140 | } 141 | 142 | // [[Rcpp::export]] 143 | Rcpp::NumericMatrix IDCT2D_retrievex(Rcpp::NumericMatrix mat) { 144 | int nrow = mat.nrow(); 145 | int ncol = mat.ncol(); 146 | Rcpp::NumericMatrix res(nrow, ncol); 147 | 148 | int nrowp1_half = (nrow + 1) / 2; 149 | int ncolp1_half = (ncol + 1) / 2; 150 | for (int i = 0; i < nrowp1_half; ++i) { 151 | for (int j = 0; j < ncolp1_half; ++j) { 152 | res(2*i,2*j) = mat(i, j); 153 | } 154 | for (int j = ncolp1_half; j < ncol; ++j) { 155 | res(2*i,2*ncol-2*j-1) = mat(i, j); 156 | } 157 | } 158 | for (int i = nrowp1_half; i < nrow; ++i) { 159 | for (int j = 0; j < ncolp1_half; ++j) { 160 | res(2*nrow-2*i-1,2*j) = mat(i,j); 161 | } 162 | for (int j = ncolp1_half; j < ncol; ++j) { 163 | res(2*nrow-2*i-1, 2*ncol-2*j-1) = mat(i,j); 164 | } 165 | } 166 | return res; 167 | } -------------------------------------------------------------------------------- /src/adaptive_double_plateaus_histogram_equalization.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Shota Ochi 3 | * All rights reserved. 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | #include 20 | 21 | // [[Rcpp::export]] 22 | Rcpp::NumericVector make_histogram_ADPHE(const Rcpp::NumericVector& ordered, const Rcpp::NumericVector& interval) 23 | { 24 | int n = ordered.size(); 25 | int m = interval.size(); 26 | Rcpp::NumericVector res(m); 27 | int count = 0; 28 | for (int i = 0; i < n; ++i) 29 | { 30 | if (ordered[i] <= interval[count]) 31 | { 32 | ++res[count]; 33 | } else 34 | { 35 | while (ordered[i] > interval[count]) 36 | { 37 | ++count; 38 | } 39 | if (count >= m) 40 | { 41 | break; 42 | } 43 | ++res[count]; 44 | } 45 | } 46 | return res; 47 | } 48 | 49 | // [[Rcpp::export]] 50 | Rcpp::NumericVector find_local_maximum_ADPHE(const Rcpp::NumericVector& hist, int n) 51 | { 52 | int size = hist.length(); 53 | int nhalf = n / 2; 54 | Rcpp::LogicalVector tmp(size); 55 | int count = 0; 56 | std::list< std::pair > window; 57 | std::pair max_elem = std::make_pair(0,0.0); 58 | 59 | for (int i = 0; i <= nhalf; ++i) 60 | { 61 | if (i < size) 62 | { 63 | std::pair tmp_pair = std::make_pair(i,hist[i]); 64 | window.push_back(tmp_pair); 65 | if (hist[i] > max_elem.second) 66 | { 67 | max_elem.first = i; 68 | max_elem.second = hist[i]; 69 | } 70 | } 71 | } 72 | if (max_elem.first == nhalf) 73 | { 74 | tmp[nhalf] = true; 75 | ++count; 76 | } 77 | int sizeminhalf = size - nhalf; 78 | for (int i = nhalf + 1; i < sizeminhalf; ++i) 79 | { 80 | int max_range = i + nhalf; 81 | window.pop_front(); 82 | std::pair tmp_pair = std::make_pair(max_range,hist[max_range]); 83 | window.push_back(tmp_pair); 84 | if (hist[max_range] > max_elem.second) 85 | { 86 | max_elem.first = max_range; 87 | max_elem.second = hist[max_range]; 88 | } 89 | if (max_elem.first < i - nhalf) 90 | { 91 | std::pair tmp_first = *(window.begin()); 92 | max_elem.first = tmp_first.first; 93 | max_elem.second = tmp_first.second; 94 | for (std::list< std::pair >::iterator itr = window.begin(); itr != window.end(); ++itr) 95 | { 96 | std::pair tmp_pair = *itr; 97 | if (tmp_pair.second > max_elem.second) 98 | { 99 | max_elem.first = tmp_pair.first; 100 | max_elem.second = tmp_pair.second; 101 | } 102 | } 103 | } 104 | if (max_elem.first == i) 105 | { 106 | tmp[i] = true; 107 | ++count; 108 | } 109 | } 110 | 111 | Rcpp::NumericVector res(count); 112 | if (count > 0) 113 | { 114 | int tmp_count = 0; 115 | for (int i = 0; i < size; ++i) 116 | { 117 | if (tmp[i]) 118 | { 119 | res[tmp_count] = hist[i]; 120 | ++tmp_count; 121 | } 122 | } 123 | } 124 | return res; 125 | } 126 | 127 | // [[Rcpp::export]] 128 | Rcpp::NumericVector modify_histogram_ADPHE(const Rcpp::NumericVector& imhist, double t_down, double t_up) 129 | { 130 | int len = imhist.length(); 131 | Rcpp::NumericVector res(len); 132 | 133 | for (int i = 0; i < len; ++i) 134 | { 135 | if (imhist[i] == 0) 136 | { 137 | res[i] = 0; 138 | } else if (imhist[i] <= t_down) 139 | { 140 | res[i] = t_down; 141 | } else if (imhist[i] < t_up) 142 | { 143 | res[i] = imhist[i]; 144 | } else 145 | { 146 | res[i] = t_up; 147 | } 148 | } 149 | return res; 150 | } 151 | 152 | // [[Rcpp::export]] 153 | Rcpp::NumericVector histogram_equalization_ADPHE(const Rcpp::NumericMatrix& im, const Rcpp::NumericVector& interval2, const Rcpp::NumericVector& imhist_modified, double min_range, double max_range) 154 | { 155 | int nrow = im.nrow(); 156 | int ncol = im.ncol(); 157 | int len = imhist_modified.length(); 158 | Rcpp::NumericMatrix res(nrow,ncol); 159 | Rcpp::NumericVector cumulative(len); 160 | cumulative[0] = 0; 161 | for (int i = 1; i < len; ++i) 162 | { 163 | cumulative[i] = cumulative[i-1] + imhist_modified[i]; 164 | } 165 | double fm = cumulative[len-1] != 0 ? cumulative[len-1] : 1; 166 | Rcpp::NumericVector hist_equalized(len); 167 | for (int i = 0; i < len; ++i) 168 | { 169 | hist_equalized[i] = (max_range - min_range) * cumulative[i] / fm + min_range; 170 | } 171 | 172 | for (int i = 0; i < nrow; ++i) 173 | { 174 | for (int j = 0; j < ncol; ++j) 175 | { 176 | int tmp_k = 0; 177 | double tmp_k_ratio = 0; 178 | for (int l = 0; l < len; ++l) 179 | { 180 | if (im(i,j) <= interval2[l]) 181 | { 182 | tmp_k = l; 183 | double tmp_min_range = l > 0 ? interval2[l-1] : 0; 184 | if (interval2[l] - tmp_min_range != 0) 185 | { 186 | tmp_k_ratio = (im(i,j) - tmp_min_range) / (interval2[l] - tmp_min_range); 187 | } else 188 | { 189 | tmp_k_ratio = -1; 190 | } 191 | break; 192 | } 193 | } 194 | double tmp_min = tmp_k > 0 ? hist_equalized[tmp_k-1] : 0; 195 | if (tmp_k_ratio >= 0) 196 | { 197 | res(i,j) = tmp_k_ratio * (hist_equalized[tmp_k] - tmp_min) + tmp_min; 198 | } else 199 | { 200 | res(i,j) = hist_equalized[tmp_k]; 201 | } 202 | } 203 | } 204 | return res; 205 | } -------------------------------------------------------------------------------- /src/chan_vese_segmentation.cpp: -------------------------------------------------------------------------------- 1 | /** 2 | * @file chanvese.c 3 | * @brief Chan-Vese active contours without edges image segmentation 4 | * @author Pascal Getreuer 5 | * 6 | * This file implements Chan-Vese active contours without edges two-phase 7 | * image segmentation. 8 | * 9 | * 10 | * Copyright (c) 2007-2012, Pascal Getreuer 11 | * All rights reserved. 12 | * 13 | * This program is free software: you can use, modify and/or 14 | * redistribute it under the terms of the simplified BSD License. You 15 | * should have received a copy of this license along this program. If 16 | * not, see . 17 | */ 18 | 19 | #include 20 | #define DIVIDE_EPS ((double)1e-16) 21 | 22 | /** @brief Default initialization for Phi */ 23 | // [[Rcpp::export]] 24 | Rcpp::NumericMatrix ChanVeseInitPhi(int Width, int Height) 25 | { 26 | Rcpp::NumericMatrix res(Width, Height); 27 | for(int i = 0; i < Width; ++i) 28 | { 29 | for(int j = 0; j < Height; ++j) 30 | { 31 | res(i,j) = (double)(sin(i*M_PI/5.0)*sin(j*M_PI/5.0)); 32 | } 33 | } 34 | return res; 35 | } 36 | 37 | // [[Rcpp::export]] 38 | Rcpp::NumericMatrix ChanVeseInitPhi_Rect(int Width, int Height, Rcpp::IntegerVector rect) 39 | { 40 | Rcpp::NumericMatrix res(Width, Height); 41 | int len_rect = rect.length(); 42 | if (len_rect != 4) 43 | { 44 | Rcpp::Rcout << "rect is not appropriate." << std::endl; 45 | return res; 46 | } 47 | int x0 = rect[0]; 48 | int y0 = rect[1]; 49 | int x1 = rect[2]; 50 | int y1 = rect[3]; 51 | if (x0 > x1) 52 | { 53 | int tmp_x = x0; 54 | x0 = x1; 55 | x1 = tmp_x; 56 | } 57 | if (y0 > y1) 58 | { 59 | int tmp_y = y0; 60 | y0 = y1; 61 | y1 = tmp_y; 62 | } 63 | 64 | for(int i = 0; i < Width; ++i) 65 | { 66 | for(int j = 0; j < Height; ++j) 67 | { 68 | if (i >= x0 && i <= x1 && j >= y0 && j <= y1) 69 | { 70 | res(i,j) = 1; 71 | } else 72 | { 73 | res(i,j) = -1; 74 | } 75 | } 76 | } 77 | return res; 78 | } 79 | 80 | /** @brief Compute averages inside and outside of the segmentation contour */ 81 | void RegionAverages_ChanVese(double *c1, double *c2, const Rcpp::NumericMatrix& Phi, const Rcpp::NumericMatrix& f, const int Width, const int Height) 82 | { 83 | const long NumPixels = ((long)Width) * ((long)Height); 84 | double Sum1 = 0, Sum2 = 0; 85 | long Count1 = 0, Count2 = 0; 86 | for (long n = 0; n < NumPixels; ++n) 87 | { 88 | if (Phi[n] >= 0) 89 | { 90 | ++Count1; 91 | Sum1 += f[n]; 92 | } 93 | else 94 | { 95 | ++Count2; 96 | Sum2 += f[n]; 97 | } 98 | } 99 | *c1 = (Count1) ? (Sum1/Count1) : 0; 100 | *c2 = (Count2) ? (Sum2/Count2) : 0; 101 | } 102 | 103 | /** 104 | * @brief Chan-Vese two-phase image segmentation 105 | * @param Phi pointer to array to hold the resulting segmentation 106 | * @param f the input image 107 | * @param Width, Height, NumChannels the size of f 108 | * @param Tol convergence tolerance 109 | * @param MaxIter maximum number of iterations 110 | * @param Mu length penalty 111 | * @param Nu area penalty (positive penalizes area inside the curve) 112 | * @param Lambda1 fit penalty inside the curve 113 | * @param Lambda2 fit penalty outside the curve 114 | * @param dt timestep 115 | * @param PlotFun function for outputting intermediate results 116 | * 117 | * This function performs Chan-Vese active contours two-phase image 118 | * segmentation by minimizing the functional 119 | * \f[ \begin{aligned}\operatorname*{arg\,min}_{c_1,c_2,C}\;& \mu 120 | * \operatorname{Length}(C) + \nu\operatorname{Area}(\mathit{inside}(C)) \\ 121 | * &+ \lambda_1 \int_{\mathit{inside}(C)}|f(x)-c_1|^2 \, dx + \lambda_2 122 | * \int_{\mathit{outside}(C)} |f(x) - c_2|^2 \, dx, \end{aligned} \f] 123 | * where the minimization is over all set boundaries C and scalars c1 and c2. 124 | * The boundary C is implicitly represented by level set function Phi. 125 | * 126 | * The input f can be a grayscale image or an image with any number of 127 | * channels, i.e., three channels for a color image, or possibly many more in a 128 | * hyperspectral image. If f is a multichannel image, the segmentation is done 129 | * using the Chan, Sandberg, Vese vector extension of the Chan-Vese model, 130 | * \f[ \begin{aligned}\operatorname*{arg\,min}_{c_1,c_2,C}\;& \mu 131 | * \operatorname{Length}(C)+\nu\operatorname{Area}(\mathit{inside}(C)) \\ &+ 132 | * \lambda_1 \int_{\mathit{inside}(C)}\|f(x)-c_1\|^2 \,dx+\lambda_2\int_{ 133 | * \mathit{outside}(C)}\|f(x)-c_2\|^2\,dx,\end{aligned} \f] 134 | * where \f$ \|\cdot\| \f$ denotes the Euclidean norm. 135 | * 136 | * The data for f should be stored as a contiguous block of data of 137 | * Width*Height*NumChannels elements, where the elements are ordered so that 138 | * f[x + Width*(y + Height*k)] = kth component of the pixel at (x,y) 139 | * 140 | * The array Phi is a contiguous array of size Width by Height with the same 141 | * order as f. Phi is a level set function of the segmentation, meaning the 142 | * segmentation is indicated by its sign: 143 | * Phi[x + Width*y] >= 0 means (x,y) is inside the segmentation curve, 144 | * Phi[x + Width*y] < 0 means (x,y) is outside. 145 | * Before calling this routine, Phi should be initialized either by calling 146 | * InitPhi or by setting it to a level set function of an initial guess of the 147 | * segmentation. After this routine, the final segmentation is obtained from 148 | * the sign of Phi. 149 | * 150 | * The routine runs at most MaxIter number of iterations and stops when the 151 | * change between successive iterations is less than Tol. Set Tol=0 to force 152 | * the routine to run exactly MaxIter iterations. 153 | */ 154 | // [[Rcpp::export]] 155 | Rcpp::List ChanVese(Rcpp::NumericMatrix im, double Mu, double Nu, double Lambda1, double Lambda2, double tol, int maxiter, double dt, Rcpp::NumericMatrix phi) 156 | { 157 | int nrow = im.nrow(); 158 | int ncol = im.ncol(); 159 | double NumPixels = nrow * ncol; 160 | double PhiDiff; 161 | double c1scalar = 0, c2scalar = 0; 162 | double *c1 = &c1scalar, *c2 = &c2scalar; 163 | double PhiLast, Delta, PhiX, PhiY, IDivU, IDivD, IDivL, IDivR; 164 | double Dist1, Dist2; 165 | int iu, id, il, ir; 166 | double PhiDiffNorm = (tol > 0) ? tol*1000 : 1000; 167 | 168 | int last_iter = 0; 169 | 170 | RegionAverages_ChanVese(c1, c2, phi, im, nrow, ncol); 171 | 172 | for (int Iter = 1; Iter <= maxiter; ++Iter) 173 | { 174 | PhiDiffNorm = 0; 175 | for (int j = 0; j < ncol; ++j) 176 | { 177 | iu = (j == 0) ? 0 : -1; 178 | id = (j == ncol - 1) ? 0 : 1; 179 | 180 | for (int i = 0; i < nrow; ++i) 181 | { 182 | il = (i == 0) ? 0 : -1; 183 | ir = (i == nrow - 1) ? 0 : 1; 184 | 185 | Delta = dt/(M_PI*(1 + phi(i,j) * phi(i,j))); 186 | PhiX = phi(i+ir,j) - phi(i,j); 187 | PhiY = (phi(i,j+id) - phi(i,j+iu))/2; 188 | IDivR = (double)(1/sqrt(DIVIDE_EPS + PhiX*PhiX + PhiY*PhiY)); 189 | PhiX = phi(i,j) - phi(i+il,j); 190 | IDivL = (double)(1/sqrt(DIVIDE_EPS + PhiX*PhiX + PhiY*PhiY)); 191 | PhiX = (phi(i+ir,j) - phi(i+il,j))/2; 192 | PhiY = phi(i,j+id) - phi(i,j); 193 | IDivD = (double)(1/sqrt(DIVIDE_EPS + PhiX*PhiX + PhiY*PhiY)); 194 | PhiY = phi(i,j) - phi(i,j+iu); 195 | IDivU = (double)(1/sqrt(DIVIDE_EPS + PhiX*PhiX + PhiY*PhiY)); 196 | 197 | Dist1 = im(i,j) - *c1; 198 | Dist2 = im(i,j) - *c2; 199 | Dist1 *= Dist1; 200 | Dist2 *= Dist2; 201 | 202 | /* Semi-implicit update of phi at the current point */ 203 | PhiLast = phi(i,j); 204 | phi(i,j) = (phi(i,j) + Delta*( 205 | Mu*(phi(i+ir,j)*IDivR + phi(i+il,j)*IDivL 206 | + phi(i,j+id)*IDivD + phi(i,j+iu)*IDivU) 207 | - Nu - Lambda1*Dist1 + Lambda2*Dist2) ) / 208 | (1 + Delta*Mu*(IDivR + IDivL + IDivD + IDivU)); 209 | PhiDiff = (phi(i,j) - PhiLast); 210 | PhiDiffNorm += PhiDiff * PhiDiff; 211 | } 212 | } 213 | PhiDiffNorm = sqrt(PhiDiffNorm/NumPixels); 214 | RegionAverages_ChanVese(c1, c2, phi, im, nrow, ncol); 215 | 216 | if (Iter >= 2 && PhiDiffNorm <= tol) 217 | { 218 | last_iter = Iter; 219 | break; 220 | } 221 | } 222 | 223 | if (last_iter == 0) 224 | { 225 | last_iter = maxiter; 226 | } 227 | return Rcpp::List::create(Rcpp::Named("num_iter") = last_iter, Rcpp::Named("result") = phi); 228 | } -------------------------------------------------------------------------------- /vignettes/intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Getting Started with imagerExtra" 3 | author: "Shota Ochi" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Getting Started with imagerExtra} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | 24 | 25 | ```{r setup, include = FALSE} 26 | knitr::opts_chunk$set(warning=FALSE, message=FALSE, cache=FALSE, 27 | comment=NA, verbose=TRUE, fig.width=5, fig.height=5, dev='jpeg',dev.args=list(quality=50)) 28 | ``` 29 | 30 | imagerExtra provides advanced functions for image processing based on the R package imager. 31 | 32 | The functions in imagerExtra are classified into 4 groups by their functions. 33 | 34 | * Contrast Enhancement 35 | * Segmentation 36 | * Denoising 37 | * Others 38 | 39 | See below to know what functions imagerExtra provides. 40 | 41 |
42 | 43 | ## Preparation 44 | 45 | Most of the functions in imagerExtra are for grayscale image. 46 | 47 | See the vignette Treating Color Image with imagerExtra if you want to treat color image with imagerExtra. 48 | 49 | Let's prepare grayscale images. 50 | 51 | ```{r, fig.width=5, fig.height=5, message=FALSE} 52 | library(imagerExtra) 53 | g <- grayscale(boats) 54 | gd <- grayscale(dogs) 55 | layout(matrix(1:2,1,2)) 56 | plot(g, main = "boats") 57 | plot(gd, main = "dogs") 58 | ``` 59 | 60 |
61 | 62 | ## Contrast Enhancement 63 | 64 | The functions for contrast enhancement are 65 | 66 | * EqualizePiecewise 67 | * BalanceSimplest 68 | * SPE 69 | * EqualizeDP 70 | * EqualizeADP 71 | 72 | ### EqualizePiecewise (Piecewise Affine Histogram Equalization) 73 | 74 | EqualizePiecewise has three parameters: *N*, *smin*, and *smax*. 75 | 76 | However, we should not change *smin*. 77 | 78 | See [Jose-Luis Lisani, et al., IPOL, 2 (2012), pp. 243-265.](https://doi.org/10.5201/ipol.2012.lps-pae) for detail. 79 | 80 | The parameter *N* controls how the input gray level will be mapped in the output image. 81 | 82 | We don't have a priori choice for *N*. You will tune *N* mainly. 83 | 84 | The parameter *smax* controls the upper limit of contrast stretching. 85 | 86 | If you want to prevent excessive enhancement of contrast, you should make *smax* low. 87 | 88 | ```{r, fig.width=8, fig.height=8} 89 | layout(matrix(1:4, 2, 2)) 90 | plot(g, main = "Original") 91 | EqualizePiecewise(g, 2) %>% plot(main = "N = 2") 92 | EqualizePiecewise(g, 10) %>% plot(main = "N = 10") 93 | EqualizePiecewise(g, 1000) %>% plot(main = "N = 1000") 94 | ``` 95 | 96 | ### BalanceSimplest (Simplest Color Balance) 97 | 98 | BalanceSimplest saturates a percentage *sleft* % of the pixels on the left side of the histogram, 99 | 100 | and a percentage *sright* % of the pixels on the right side of the histogram. 101 | 102 | See [Nicolas Limare, et al., IPOL, 1 (2011), pp. 297-315.](https://doi.org/10.5201/ipol.2011.llmps-scb) for detail. 103 | 104 | ```{r, fig.width=7} 105 | layout(matrix(1:2, 1, 2)) 106 | plot(g, main = "Original") 107 | BalanceSimplest(g, 1, 1) %>% plot(main = "sleft = 1, sright = 1") 108 | ``` 109 | 110 | ### SPE (Screened Poisson Equation) 111 | 112 | The distinction of SPE is that SPE corrects the inhomogeneous background of image. 113 | 114 | See [Jean-Michel Morel, et al., IPOL, 4 (2014), pp. 16-29.](https://doi.org/10.5201/ipol.2014.84) for detail. 115 | 116 | The parameter *lamda* controls how strong corrects inhomogeneous background of image. 117 | 118 | SPE corrects inhomogeneous background strongly if *lamda* is large. 119 | 120 | ```{r, fig.height=3} 121 | layout(matrix(1:2, 1, 2)) 122 | plot(papers, main = "Original") 123 | SPE(papers, 0.1) %>% plot(main = "SPE (lamda = 0.1)") 124 | ``` 125 | 126 | ### EqualizeDP (Double Plateaus Histogram Equalization) 127 | 128 | Double plateaus histogram equalization (DPHE) enhances contrast of image while preventing over-enhancement of background noise and protecting details of objects in images. 129 | 130 | DPHE modifies original histogram as shown below, and then apply histogram equalization. 131 | $$ 132 | H_{m}(g) = \begin{cases} 133 | T_{UP} & h(g) >= T_{UP} \\ 134 | h(g) & T_{DOWN} < h(g) < T_{UP} \\ 135 | T_{DOWN} & h(g) <= T_{DOWN} 136 | \end{cases} 137 | $$ 138 | where $g$ is the gray level, $h(g)$ is the original histogram, and $H_{m}(g)$ is the modified histogram. 139 | 140 | You will tune the two key parameters, $T_{DOWN}$ and $T_{UP}$. 141 | 142 | ```{r, fig.width=7} 143 | layout(matrix(1:2, 1, 2)) 144 | plot(gd, main = "Original") 145 | EqualizeDP(gd, 25, 110) %>% plot(main = "DPHE") 146 | ``` 147 | 148 | ### EqualizeADP (Adaptive Double Plateaus Histogram Equalization) 149 | 150 | Adaptive double plateaus histogram equalization (ADPHE) computes $T_{DOWN}$ and $T_{UP}$ automatically, and then apply DPHE. 151 | 152 | ```{r, fig.width=7} 153 | layout(matrix(1:2, 1, 2)) 154 | plot(gd, main = "Original") 155 | EqualizeADP(gd) %>% plot(main = "ADPHE") 156 | ``` 157 | 158 |
159 | 160 | ## Denoising 161 | 162 | The function for image denoising is 163 | 164 | * DenoiseDCT 165 | 166 | ### DenoiseDCT (DCT denoising) 167 | 168 | DCT denoising is a simple and effective denoising algorithm using local DCT thresholding. 169 | 170 | See [Guoshen Yu, and Guillermo Sapiro, IPOL, 1 (2011), pp. 292-296.](https://doi.org/10.5201/ipol.2011.ys-dct) for detail. 171 | 172 | The parameter *sdn* determines how strong denoise a image. 173 | 174 | Noise is strongly denoised if *sdn* is large. 175 | 176 | The parameter *flag_dct16x16* determines window size of local patches. 177 | 178 | DenoiseDCT uses 8x8 windows or 16x16 window. 179 | 180 | Larger window size does not bring significant improvement when noise level is low. 181 | 182 | Larger window size outperforms significantly smaller window size when noise level is low. 183 | 184 | ```{r, fig.width=7, fig.height=7} 185 | noisy <- g + imnoise(dim = dim(g), sd = 0.1) 186 | layout(matrix(c(1,3,2,4), 2, 2)) 187 | plot(g, main = "Original") 188 | plot(noisy, main = "Noisy Boats") 189 | DenoiseDCT(noisy, 0.1) %>% plot(., main = "Denoised (8x8 window)") 190 | DenoiseDCT(noisy, 0.1, flag_dct16x16 = TRUE) %>% plot(., main = "Denoised (16x16 window)") 191 | ``` 192 | 193 |
194 | 195 | ## Segmentation 196 | 197 | The functions for image segmentation are 198 | 199 | * ThresholdTriclass 200 | * ThresholdAdaptive 201 | * ThresholdFuzzy 202 | * ThresholdML 203 | * SegmentCV 204 | 205 | ### ThresholdTriclass (Iterative Triclass Thresholding) 206 | 207 | Iterative triclass thresholding is an iterative thresholding technique. 208 | 209 | We need to set a rule to stop iteration. 210 | 211 | We have two options. 212 | 213 | * set preset threshold (*stopval*) 214 | * set repeat number (*repeatnum*) 215 | 216 | ```{r, fig.width=7, fig.height=7} 217 | gdogs <- grayscale(dogs) 218 | layout(matrix(1:4, 2, 2, byrow = TRUE)) 219 | plot(gdogs, main = "Original", axes=F) 220 | ThresholdTriclass(gdogs, stopval = 0.001) %>% plot(main = "stopval = 0.001") 221 | ThresholdTriclass(gdogs, repeatnum = 1) %>% plot(main = "repeatnum = 1") 222 | ThresholdTriclass(gdogs, repeatnum = 3) %>% plot(main = "repeatnum = 3") 223 | ``` 224 | 225 | ### ThresholdAdaptive (Local Adaptive Thresholding) 226 | 227 | Local adaptive thresholding can extract objects from inhomogeneous background. 228 | 229 | You will tune the two paramters k and windowsize. 230 | 231 | Note that the parameter *range* determines max standard deviation. 232 | 233 | you should set *range* as [0,1] if you treat a image whose pixel values are in [0,1]. 234 | 235 | ```{r, fig.height=3} 236 | layout(matrix(1:2,1,2)) 237 | plot(papers, main = "Original") 238 | hello <- ThresholdAdaptive(papers, 0.1, windowsize = 17, range = c(0,1)) 239 | plot(hello, main = "Binarizesd") 240 | ``` 241 | 242 | ### ThresholdFuzzy (Fuzzy Thresholding) 243 | 244 | Fuzzy thresholding is an automatic thresholding based on fuzzy set theory. 245 | 246 | ```{r, fig.width=7} 247 | layout(matrix(1:2,1,2)) 248 | plot(g, main = "Original") 249 | ThresholdFuzzy(g) %>% plot(main = "Fuzzy Thresholding") 250 | ``` 251 | 252 | ### ThresholdML (Multilevel Thresholding) 253 | 254 | Multilevel thresholding segments an image into several gray levels. 255 | 256 | You can specify level of thresholds or values of thresholds. 257 | 258 | The values of thresholds are computed automatically if you specify the level of thresholds. 259 | 260 | ```{r, fig.width=7} 261 | layout(matrix(1:2,1,2)) 262 | ThresholdML(g, k = 3) %>% plot(main = "Level of Thresholds: 3") 263 | ThresholdML(g, thr = c(0.2, 0.4, 0.6)) %>% plot(main = "Thresholds: 0.2, 0.4, and 0.6") 264 | ``` 265 | 266 | ### SegmentCV (Chan-Vese Segmentation) 267 | 268 | Chan-Vese segmentation (CVS) is an iterative region-based segmentation algorithm. 269 | 270 | CVS can extract objects whose pixel values aren't homogeneous. 271 | 272 | This is the distinction of CVS. 273 | 274 | SegmentCV has many arguments and most of the arguments are key paramters. 275 | 276 | It's too many to explain briefly. 277 | 278 | See [Pascal Getreuer (2012). Chan-Vese Segmentation. Image Processing On Line 2, 214-224.](https://doi.org/10.5201/ipol.2012.g-cv) for detail. 279 | 280 | ```{r, fig.width=7} 281 | layout(matrix(1:2, 1, 2)) 282 | plot(gd, main = "Original") 283 | SegmentCV(gd, lambda2 = 15) %>% plot(main = "Chan-Vese") 284 | ``` 285 | 286 |
287 | 288 | ## Others 289 | 290 | The functions classified as others are 291 | 292 | * Grayscale 293 | * GetHue 294 | * RestoreHue 295 | * OCR 296 | * OCR_data 297 | 298 | ### Grayscale, GetHue, and RestoreHue 299 | 300 | These functions are for treating color image with imagerExtra. 301 | 302 | See the vignette Treating Color Image with imagerExtra for detail. 303 | 304 | ### OCR and OCR_data 305 | 306 | These functions are wrappers for ocr function and ocr_data function of the R package tesseract. 307 | 308 | See the vignette Optical Character Recognition with imagerExtra for detail. 309 | -------------------------------------------------------------------------------- /src/fuzzy_thresholding.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Shota Ochi 3 | * All rights reserved. 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | #include 20 | 21 | #define N_PARAMS 2 22 | 23 | // [[Rcpp::export]] 24 | Rcpp::NumericVector make_histogram_fuzzy(Rcpp::NumericVector ordered, Rcpp::NumericVector interval) 25 | { 26 | int n = ordered.size(); 27 | int m = interval.size(); 28 | Rcpp::NumericVector res(m); 29 | int count = 0; 30 | for (int i = 0; i < n; ++i) 31 | { 32 | if (ordered[i] <= interval[count]) 33 | { 34 | ++res[count]; 35 | } else 36 | { 37 | while (ordered[i] > interval[count]) 38 | { 39 | ++count; 40 | } 41 | if (count >= m) 42 | { 43 | break; 44 | } 45 | ++res[count]; 46 | } 47 | } 48 | return res; 49 | } 50 | 51 | double calc_fuzzy_entropy(Rcpp::NumericVector imhist, Rcpp::NumericVector interval, int idx_a, int idx_c) 52 | { 53 | int n = imhist.size(); 54 | double a = interval[idx_a]; 55 | double c = interval[idx_c]; 56 | double b = (a + c) / 2; 57 | double res = 0.0; 58 | for (int i = 0; i < n; ++i) 59 | { 60 | double mu = 0; 61 | if (interval[i] > a) 62 | { 63 | if (interval[i] < b) 64 | { 65 | mu = 2 * ((interval[i] - a) / (c - a)) * ((interval[i] - a) / (c - a)); 66 | } else if (interval[i] < c) 67 | { 68 | mu = 1 - 2 * ((c - interval[i]) / (c - a)) * ((c - interval[i]) / (c - a)); 69 | } else 70 | { 71 | mu = 1; 72 | } 73 | } 74 | double shannonf = 0.0; 75 | if (mu != 0.0 && mu != 1.0) 76 | { 77 | shannonf = -mu * std::log(mu) - (1 - mu) * std::log(1 - mu); 78 | } 79 | res += shannonf * imhist[i]; 80 | } 81 | return res; 82 | } 83 | 84 | bool check_dupl_fuzzy(Rcpp::IntegerVector vec) 85 | { 86 | int n = vec.size(); 87 | bool res = false; 88 | for (int i = 0; i < n - 1; ++i) 89 | { 90 | if (vec[i] == vec[i+1]) 91 | { 92 | res = true; 93 | break; 94 | } 95 | } 96 | return res; 97 | } 98 | 99 | Rcpp::IntegerVector generate_pos_fuzzy(int n_interval) 100 | { 101 | Rcpp::IntegerVector res(N_PARAMS); 102 | if (n_interval < N_PARAMS) 103 | { 104 | Rcpp::Rcout << "n_interval is smaller than " << N_PARAMS << "." << std::endl; 105 | return res; 106 | } 107 | Rcpp::NumericVector tmprand = Rcpp::runif(N_PARAMS, 0, n_interval); 108 | for (int i = 0; i < N_PARAMS; ++i) 109 | { 110 | res[i] = (int)(tmprand[i]); 111 | } 112 | std::sort(res.begin(), res.end()); 113 | bool flag_dupl = check_dupl_fuzzy(res); 114 | while (flag_dupl) 115 | { 116 | tmprand = Rcpp::runif(N_PARAMS, 0, n_interval); 117 | for (int i = 0; i < N_PARAMS; ++i) 118 | { 119 | res[i] = (int)(tmprand[i]); 120 | } 121 | std::sort(res.begin(), res.end()); 122 | flag_dupl = check_dupl_fuzzy(res); 123 | } 124 | return res; 125 | } 126 | 127 | Rcpp::IntegerMatrix generate_inipos_fuzzy(int n, int n_interval) 128 | { 129 | Rcpp::IntegerMatrix res(n, N_PARAMS); 130 | for (int i = 0; i < n; ++i) 131 | { 132 | Rcpp::IntegerVector tmp = generate_pos_fuzzy(n_interval); 133 | for (int j = 0; j < N_PARAMS; ++j) 134 | { 135 | res(i,j) = tmp[j]; 136 | } 137 | } 138 | return res; 139 | } 140 | 141 | Rcpp::NumericMatrix generate_iniv_fuzzy(int n, double vmax) 142 | { 143 | Rcpp::NumericMatrix res(n, N_PARAMS); 144 | for (int i = 0; i < n; ++i) 145 | { 146 | Rcpp::NumericVector tmp = Rcpp::runif(N_PARAMS, 0, 1); 147 | for (int j = 0; j < N_PARAMS; ++j) 148 | { 149 | res(i,j) = vmax * (tmp[j] + tmp[j] - 1); 150 | } 151 | } 152 | return res; 153 | } 154 | 155 | // [[Rcpp::export]] 156 | double fuzzy_threshold(Rcpp::NumericVector imhist, Rcpp::NumericVector interval, int n, int maxiter, double omegamax, double omegamin, double c1, double c2, double mutrate, double vmax, int localsearch) 157 | { 158 | // sanity ckeck 159 | if (imhist.size() != interval.size()) 160 | { 161 | Rcpp::Rcout << "The length of imhist is not same as the length of interval." << std::endl; 162 | return 0.0; 163 | } 164 | if (maxiter < 2) 165 | { 166 | Rcpp::Rcout << "maxiter must be greater than or equal to 2." << std::endl; 167 | return 0.0; 168 | } 169 | 170 | int n_interval = interval.size(); 171 | Rcpp::IntegerMatrix pos = generate_inipos_fuzzy(n, n_interval); 172 | Rcpp::NumericMatrix v = generate_iniv_fuzzy(n, vmax); 173 | Rcpp::IntegerVector gbest(N_PARAMS); 174 | double gbeste = 0; 175 | double omegacoef = (omegamax - omegamin) / (maxiter - 1); 176 | Rcpp::IntegerMatrix pbest(n,N_PARAMS); // a, c(from left to right) 177 | Rcpp::NumericVector pbeste(n); // maximum entropy of each particles 178 | double vmax_squared = vmax * vmax; 179 | Rcpp::IntegerMatrix prepos(n,N_PARAMS); 180 | Rcpp::NumericMatrix prev(n,N_PARAMS); 181 | double sigma = 0.1 * n_interval; 182 | 183 | for (int i = 0; i < n; ++i) 184 | { 185 | for (int j = 0; j < N_PARAMS; ++j) 186 | { 187 | pbest(i,j) = pos(i,j); 188 | prepos(i,j) = pos(i,j); 189 | prev(i,j) = v(i,j); 190 | } 191 | pbeste[i] = calc_fuzzy_entropy(imhist, interval, pos(i,0), pos(i,1)); 192 | if (pbeste[i] > gbeste) 193 | { 194 | for (int j = 0; j < N_PARAMS; ++j) 195 | { 196 | gbest[j] = pbest(i,j); 197 | } 198 | gbeste = pbeste[i]; 199 | } 200 | } 201 | for(int k = 1; k < maxiter; ++k) 202 | { 203 | double omegak = omegamax - k * omegacoef; 204 | for (int i = 0; i < n; ++i) 205 | { 206 | bool flag_range = false; 207 | for (int j = 0; j < N_PARAMS; ++j) 208 | { 209 | Rcpp::NumericVector temprunif = Rcpp::runif(2); 210 | v(i,j) = v(i,j) * omegak + c1 * temprunif[0] * (pbest(i,j) - prepos(i,j)) + c2 * temprunif[1] * (gbest[j] - prepos(i,j)); 211 | pos(i,j) = (int)(prepos(i,j) + prev(i,j)); 212 | if (pos(i,j) < 0 || pos(i,j) >= n_interval) 213 | { 214 | flag_range = true; 215 | } 216 | } 217 | double vmag = 0.0; 218 | for (int j = 0; j < N_PARAMS; ++j) 219 | { 220 | vmag += v(i,j) * v(i,j); 221 | } 222 | if (vmag > vmax_squared) 223 | { 224 | double vmag_sqrt = sqrt(vmag); 225 | for (int j = 0; j < N_PARAMS; ++j) 226 | { 227 | v(i,j) *= vmax / vmag_sqrt; 228 | } 229 | } 230 | for (int j = 0; j < N_PARAMS - 1; ++j) 231 | { 232 | if (pos(i,j) >= pos(i,j+1)) 233 | { 234 | flag_range = true; 235 | } 236 | } 237 | if (flag_range) 238 | { 239 | Rcpp::IntegerVector tmp_newpos = generate_pos_fuzzy(n_interval); 240 | for (int j = 0; j < N_PARAMS; ++j) 241 | { 242 | pos(i,j) = tmp_newpos[j]; 243 | } 244 | } 245 | double tempe = calc_fuzzy_entropy(imhist, interval, pos(i,0), pos(i,1)); 246 | //gaussian mutation 247 | Rcpp::NumericVector mutran = Rcpp::runif(1); 248 | if (mutran[0] <= mutrate) 249 | { 250 | Rcpp::NumericVector tempgaus = Rcpp::rnorm(N_PARAMS,0,sigma); 251 | Rcpp::IntegerVector tmppos(N_PARAMS); 252 | bool bool_gaus = true; 253 | for (int j = 0; j < N_PARAMS; ++j) 254 | { 255 | tmppos[j] = (int)(pos(i,j) * (1 + tempgaus[j])); 256 | if (tmppos[j] < 0 || tmppos[j] >= n_interval) 257 | { 258 | bool_gaus = false; 259 | } 260 | } 261 | for (int j = 0; j < N_PARAMS - 1; ++j) 262 | { 263 | if (tmppos[j] >= tmppos[j+1]) 264 | { 265 | bool_gaus = false; 266 | } 267 | } 268 | if (bool_gaus) 269 | { 270 | double mute = calc_fuzzy_entropy(imhist, interval, tmppos[0], tmppos[1]); 271 | if (mute > tempe) 272 | { 273 | for (int j = 0; j < N_PARAMS; ++j) 274 | { 275 | pos(i,j) = tmppos[j]; 276 | } 277 | tempe = mute; 278 | } 279 | } 280 | } 281 | 282 | if (tempe >= pbeste[i]) 283 | { 284 | for (int j = 0; j < N_PARAMS; ++j) 285 | { 286 | pbest(i,j) = pos(i,j); 287 | } 288 | pbeste[i] = tempe; 289 | if (tempe >= gbeste) 290 | { 291 | for (int j = 0; j < N_PARAMS; ++j) 292 | { 293 | gbest[j] = pos(i,j); 294 | } 295 | gbeste = tempe; 296 | } 297 | } 298 | for (int j = 0; j < N_PARAMS; ++j) 299 | { 300 | prepos(i,j) = pos(i,j); 301 | prev(i,j) = v(i,j); 302 | } 303 | } 304 | } 305 | 306 | // local search 307 | Rcpp::IntegerVector localmin(N_PARAMS); 308 | Rcpp::IntegerVector localmax(N_PARAMS); 309 | for (int j = 0; j < N_PARAMS; ++j) 310 | { 311 | localmin[j] = gbest[j] - localsearch > 0 ? gbest[j] - localsearch : 0; 312 | localmax[j] = gbest[j] + localsearch < n_interval ? gbest[j] + localsearch : n_interval - 1; 313 | } 314 | for (int ia = localmin[0]; ia <= localmax[0]; ++ia) 315 | { 316 | for (int ic = localmin[1]; ic <= localmax[1]; ++ic) 317 | { 318 | if (ia < ic) 319 | { 320 | double tempe = calc_fuzzy_entropy(imhist, interval, ia, ic); 321 | if (tempe > gbeste) 322 | { 323 | gbest[0] = ia; 324 | gbest[1] = ic; 325 | gbeste = tempe; 326 | } 327 | } 328 | } 329 | } 330 | 331 | return (interval[gbest[0]] + interval[gbest[1]]) / 2; 332 | } -------------------------------------------------------------------------------- /src/local_adaptive_thresholding.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Shota Ochi 3 | * All rights reserved. 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | //$ @references Faisal Shafait, Daniel Keysers, Thomas M. Breuel, "Efficient implementation of local adaptive thresholding techniques using integral images", Proc. SPIE 6815, Document Recognition and Retrieval XV, 681510 (28 January 2008) 20 | 21 | #include 22 | 23 | Rcpp::NumericMatrix calc_integralsum(Rcpp::NumericMatrix mat) { 24 | int nrow = mat.nrow(); 25 | int ncol = mat.ncol(); 26 | Rcpp::NumericMatrix res(nrow, ncol); 27 | 28 | res(0,0) = mat(0,0); 29 | for (int i = 1; i < nrow; ++i) { 30 | res(i,0) = mat(i,0) + res(i-1,0); 31 | } 32 | for (int j = 1; j < ncol; ++j) { 33 | res(0,j) = mat(0,j) + res(0,j-1); 34 | } 35 | for (int i = 1; i < nrow; ++i) { 36 | for (int j = 1; j < ncol; ++j) { 37 | res(i,j) = mat(i,j) + res(i-1,j) + res(i,j-1) - res(i-1,j-1); 38 | } 39 | } 40 | return res; 41 | } 42 | 43 | Rcpp::NumericMatrix calc_integralsum_squared(Rcpp::NumericMatrix mat) { 44 | int nrow = mat.nrow(); 45 | int ncol = mat.ncol(); 46 | Rcpp::NumericMatrix mat_squared(nrow, ncol); 47 | Rcpp::NumericMatrix res(nrow, ncol); 48 | 49 | for (int i = 0; i < nrow; ++i) { 50 | for (int j = 0; j < ncol; ++j) { 51 | mat_squared(i,j) = mat(i,j) * mat(i,j); 52 | } 53 | } 54 | 55 | res(0,0) = mat_squared(0,0); 56 | for (int i = 1; i < nrow; ++i) { 57 | res(i,0) = mat_squared(i,0) + res(i-1,0); 58 | } 59 | for (int j = 1; j < ncol; ++j) { 60 | res(0,j) = mat_squared(0,j) + res(0,j-1); 61 | } 62 | for (int i = 1; i < nrow; ++i) { 63 | for (int j = 1; j < ncol; ++j) { 64 | res(i,j) = mat_squared(i,j) + res(i-1,j) + res(i,j-1) - res(i-1,j-1); 65 | } 66 | } 67 | return res; 68 | } 69 | 70 | // [[Rcpp::export]] 71 | Rcpp::NumericMatrix threshold_adaptive(Rcpp::NumericMatrix mat, double k, int windowsize, double maxsd) { 72 | int nrow = mat.nrow(); 73 | int ncol = mat.ncol(); 74 | Rcpp::NumericMatrix res(nrow, ncol); 75 | Rcpp::NumericMatrix integralsum = calc_integralsum(mat); 76 | Rcpp::NumericMatrix integralsum_squared = calc_integralsum_squared(mat); 77 | int winhalf = windowsize / 2; 78 | int winsize_squared = windowsize * windowsize; 79 | int nrow_center = nrow - windowsize; 80 | int ncol_center = ncol - windowsize; 81 | 82 | // sanity check for windowsize 83 | if (windowsize < 1) { 84 | Rcpp::Rcout << "Error: window size must be positive." << std::endl; 85 | return res; 86 | } 87 | // sanity check for windowsize and matsize 88 | if (nrow < windowsize || ncol < windowsize) { 89 | Rcpp::Rcout << "Error: windowsize is too large." << std::endl; 90 | return res; 91 | } 92 | // sanity check for maxsd 93 | if (maxsd == 0.0) { 94 | Rcpp::Rcout << "Error: maxsd is 0." << std::endl; 95 | return res; 96 | } 97 | // sanity check for k 98 | if (k < 0.0 || k > 1.0) { 99 | Rcpp::Rcout << "Error: k is out of range. k must be in [0,1]." << std::endl; 100 | return res; 101 | } 102 | 103 | for (int i = 0; i < winhalf; ++i) { 104 | for (int j = 0; j < winhalf; ++j) { 105 | int temp_winsize = (winhalf + i + 1) * (winhalf + j + 1); 106 | double mean_local = integralsum(i+winhalf,j+winhalf) / temp_winsize; 107 | double sd_local = sqrt(integralsum_squared(i+winhalf,j+winhalf) / temp_winsize - mean_local * mean_local); 108 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 109 | if (mat(i,j) <= threshold_local) { 110 | res(i,j) = 0; 111 | } else { 112 | res(i,j) = 1; 113 | } 114 | } 115 | } 116 | 117 | for (int i = winhalf; i < nrow_center; ++i) { 118 | for (int j =0; j < winhalf; ++j) { 119 | int temp_winsize = windowsize * (winhalf + j + 1); 120 | double mean_local = (integralsum(i+winhalf,j+winhalf) - integralsum(i-winhalf,j+winhalf)) / temp_winsize; 121 | double sd_local = sqrt((integralsum_squared(i+winhalf,j+winhalf) - integralsum_squared(i-winhalf,j+winhalf)) / temp_winsize - mean_local * mean_local); 122 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 123 | if (mat(i,j) <= threshold_local) { 124 | res(i,j) = 0; 125 | } else { 126 | res(i,j) = 1; 127 | } 128 | } 129 | } 130 | 131 | for (int i = nrow_center; i < nrow; ++i) { 132 | for (int j = 0; j < winhalf; ++j) { 133 | int temp_winsize = (winhalf + nrow - i) * (winhalf + j + 1); 134 | double mean_local = (integralsum(nrow-1,j+winhalf) - integralsum(i-winhalf,j+winhalf)) / temp_winsize; 135 | double sd_local = sqrt((integralsum_squared(nrow-1,j+winhalf) - integralsum_squared(i-winhalf,j+winhalf)) / temp_winsize - mean_local * mean_local); 136 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 137 | if (mat(i,j) <= threshold_local) { 138 | res(i,j) = 0; 139 | } else { 140 | res(i,j) = 1; 141 | } 142 | } 143 | } 144 | 145 | for (int i = 0; i < winhalf; ++i) { 146 | for (int j = winhalf; j < ncol_center; ++j) { 147 | int temp_winsize = (winhalf + i + 1) * windowsize; 148 | double mean_local = (integralsum(i+winhalf,j+winhalf) - integralsum(i+winhalf,j-winhalf)) / temp_winsize; 149 | double sd_local = sqrt((integralsum_squared(i+winhalf,j+winhalf) - integralsum_squared(i+winhalf,j-winhalf)) / temp_winsize - mean_local * mean_local); 150 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 151 | if (mat(i,j) <= threshold_local) { 152 | res(i,j) = 0; 153 | } else { 154 | res(i,j) = 1; 155 | } 156 | } 157 | } 158 | 159 | for (int i = winhalf; i < nrow_center; ++i) { 160 | for (int j = winhalf; j < ncol_center; ++j) { 161 | double mean_local = (integralsum(i+winhalf,j+winhalf) + integralsum(i-winhalf,j-winhalf) - integralsum(i+winhalf,j-winhalf) - integralsum(i-winhalf,j+winhalf)) / winsize_squared; 162 | double sd_local = sqrt((integralsum_squared(i+winhalf,j+winhalf) + integralsum_squared(i-winhalf,j-winhalf) - integralsum_squared(i+winhalf,j-winhalf) - integralsum_squared(i-winhalf,j+winhalf)) / winsize_squared - mean_local * mean_local); 163 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 164 | if (mat(i,j) <= threshold_local) { 165 | res(i,j) = 0; 166 | } else { 167 | res(i,j) = 1; 168 | } 169 | } 170 | } 171 | 172 | for (int i = nrow_center; i < nrow; ++i) { 173 | for (int j = winhalf; j < ncol_center; ++j) { 174 | int temp_winsize = (winhalf + nrow - i) * windowsize; 175 | double mean_local = (integralsum(nrow-1,j+winhalf) + integralsum(i-winhalf,j-winhalf) - integralsum(nrow-1,j-winhalf) - integralsum(i-winhalf,j+winhalf)) / temp_winsize; 176 | double sd_local = sqrt((integralsum_squared(nrow-1,j+winhalf) + integralsum_squared(i-winhalf,j-winhalf) - integralsum_squared(nrow-1,j-winhalf) - integralsum_squared(i-winhalf,j+winhalf)) / temp_winsize - mean_local * mean_local); 177 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 178 | if (mat(i,j) <= threshold_local) { 179 | res(i,j) = 0; 180 | } else { 181 | res(i,j) = 1; 182 | } 183 | } 184 | } 185 | 186 | for (int i = 0; i < winhalf; ++i) { 187 | for (int j = ncol_center; j < ncol; ++j) { 188 | int temp_winsize = (winhalf + i + 1) * (winhalf + ncol - j); 189 | double mean_local = (integralsum(i+winhalf,ncol-1) - integralsum(i+winhalf,j-winhalf)) / temp_winsize; 190 | double sd_local = sqrt((integralsum_squared(i+winhalf,ncol-1) - integralsum_squared(i+winhalf,j-winhalf)) / temp_winsize - mean_local * mean_local); 191 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 192 | if (mat(i,j) <= threshold_local) { 193 | res(i,j) = 0; 194 | } else { 195 | res(i,j) = 1; 196 | } 197 | } 198 | } 199 | 200 | for (int i = winhalf; i < nrow_center; ++i) { 201 | for (int j = ncol_center; j < ncol; ++j) { 202 | int temp_winsize = windowsize * (winhalf + ncol - j); 203 | double mean_local = (integralsum(i+winhalf,ncol-1) + integralsum(i-winhalf,j-winhalf) - integralsum(i+winhalf,j-winhalf) - integralsum(i-winhalf,ncol-1)) / temp_winsize; 204 | double sd_local = sqrt((integralsum_squared(i+winhalf,ncol-1) + integralsum_squared(i-winhalf,j-winhalf) - integralsum_squared(i+winhalf,j-winhalf) - integralsum_squared(i-winhalf,ncol-1)) / temp_winsize - mean_local * mean_local); 205 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 206 | if (mat(i,j) <= threshold_local) { 207 | res(i,j) = 0; 208 | } else { 209 | res(i,j) = 1; 210 | } 211 | } 212 | } 213 | 214 | for (int i = nrow_center; i < nrow; ++i) { 215 | for (int j = ncol_center; j < ncol; ++j) { 216 | int temp_winsize = (winhalf + nrow - i) * (winhalf + ncol - j); 217 | double mean_local = (integralsum(nrow-1,ncol-1) + integralsum(i-winhalf,j-winhalf) - integralsum(nrow-1,j-winhalf) - integralsum(i-winhalf,ncol-1)) / temp_winsize; 218 | double sd_local = sqrt((integralsum_squared(nrow-1,ncol-1) + integralsum_squared(i-winhalf,j-winhalf) - integralsum_squared(nrow-1,j-winhalf) - integralsum_squared(i-winhalf,ncol-1)) / temp_winsize - mean_local * mean_local); 219 | double threshold_local = mean_local * (1 + k * (sd_local / maxsd - 1)); 220 | if (mat(i,j) <= threshold_local) { 221 | res(i,j) = 0; 222 | } else { 223 | res(i,j) = 1; 224 | } 225 | } 226 | } 227 | 228 | return res; 229 | } -------------------------------------------------------------------------------- /src/multilevel_thresholding.cpp: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2018, Shota Ochi 3 | * All rights reserved. 4 | * 5 | * This program is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 3 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program. If not, see . 17 | */ 18 | 19 | #include 20 | 21 | // [[Rcpp::export]] 22 | Rcpp::NumericVector make_density_multilevel(Rcpp::NumericVector ordered, Rcpp::NumericVector interval) 23 | { 24 | int n = ordered.size(); 25 | int m = interval.size(); 26 | if (n == 0) 27 | { 28 | Rcpp::Rcout << "Error: The length of ordered is 0." << std::endl; 29 | return 0.0; 30 | } 31 | if (m == 0) 32 | { 33 | Rcpp::Rcout << "Error: The length of interval is 0." << std::endl; 34 | return 0.0; 35 | } 36 | Rcpp::NumericVector res(m); 37 | int count = 0; 38 | for (int i = 0; i < n; ++i) 39 | { 40 | if (ordered[i] <= interval[count]) 41 | { 42 | ++res[count]; 43 | } else 44 | { 45 | while (ordered[i] > interval[count]) 46 | { 47 | ++count; 48 | } 49 | if (count >= m) 50 | { 51 | break; 52 | } 53 | ++res[count]; 54 | } 55 | } 56 | for (int i = 0; i < m; ++i) 57 | { 58 | res[i] /= n; 59 | } 60 | return res; 61 | } 62 | 63 | // [[Rcpp::export]] 64 | Rcpp::NumericVector make_integral_density_multilevel(Rcpp::NumericVector density) 65 | { 66 | int n = density.size(); 67 | if (n == 0) 68 | { 69 | Rcpp::Rcout << "Error: The length of ordered is 0." << std::endl; 70 | return 0.0; 71 | } 72 | Rcpp::NumericVector res(n); 73 | double temp = 0.0; 74 | for (int i = 0; i < n; ++i) 75 | { 76 | temp += density[i]; 77 | res[i] = temp; 78 | } 79 | return res; 80 | } 81 | 82 | double calculate_entropy_multilevel(Rcpp::NumericVector density, Rcpp::NumericVector integral_density, Rcpp::IntegerVector thresholds) 83 | { 84 | int n = density.size(); 85 | int k = thresholds.size(); 86 | double res = 0.0; 87 | 88 | double omega0 = integral_density[thresholds[0]]; 89 | double h0 = 0.0; 90 | if (omega0 != 0.0) 91 | { 92 | for (int j = 0; j <= thresholds[0]; ++j) 93 | { 94 | if (density[j] != 0.0) 95 | { 96 | h0 += density[j] * std::log(density[j] / omega0) / omega0; 97 | } 98 | } 99 | } 100 | res -= h0; 101 | for (int i = 1; i < k; ++i) 102 | { 103 | double omegak = integral_density[thresholds[i]] - integral_density[thresholds[i-1]]; 104 | double hk = 0.0; 105 | for (int j = thresholds[i-1] + 1; j <= thresholds[i]; ++j) 106 | { 107 | if (density[j] != 0.0) 108 | { 109 | hk += density[j] * std::log(density[j] / omegak) / omegak; 110 | } 111 | } 112 | res -= hk; 113 | } 114 | double omegan = integral_density[n-1] - integral_density[thresholds[k-1]]; 115 | double hn = 0.0; 116 | if (omegan != 0.0) 117 | { 118 | for (int j = thresholds[k-1]; j < n; ++j) 119 | { 120 | if (density[j] != 0.0) 121 | { 122 | hn += density[j] * std::log(density[j] / omegan) / omegan; 123 | } 124 | } 125 | } 126 | res -= hn; 127 | return res; 128 | } 129 | 130 | Rcpp::IntegerVector generate_inipos_multilevel(int n_thres, int maxnum_interval) 131 | { 132 | Rcpp::IntegerVector res(n_thres); 133 | Rcpp::NumericVector tmp = Rcpp::runif(n_thres, 0, maxnum_interval); 134 | std::sort(tmp.begin(), tmp.end()); 135 | for (int i = 0; i < n_thres; ++i) 136 | { 137 | tmp[i] = (int)tmp[i]; 138 | } 139 | bool tmpbool = false; 140 | for (int i = 0; i < n_thres - 1; ++i) 141 | { 142 | if (tmp[i] == tmp[i+1]) 143 | { 144 | tmpbool = true; 145 | break; 146 | } 147 | } 148 | while (tmpbool) 149 | { 150 | tmp = Rcpp::runif(n_thres, 0, maxnum_interval); 151 | std::sort(tmp.begin(), tmp.end()); 152 | for (int j = 0; j < n_thres; ++j) 153 | { 154 | tmp[j] = (int)tmp[j]; 155 | } 156 | tmpbool = false; 157 | for (int i = 0; i < n_thres - 1; ++i) 158 | { 159 | if (tmp[i] == tmp[i+1]) 160 | { 161 | tmpbool = true; 162 | break; 163 | } 164 | } 165 | } 166 | for (int i = 0; i < n_thres; ++i) 167 | { 168 | res[i] = (int)tmp[i]; 169 | } 170 | return res; 171 | } 172 | 173 | int generate_randint_multilevel(int n_ex, int maxnum) 174 | { 175 | if (maxnum <= 1) 176 | { 177 | Rcpp::Rcout << "maxnum is smaller than 2 in generate_randint_multilevel." << std::endl; 178 | return 0; 179 | } 180 | Rcpp::NumericVector tmp = Rcpp::runif(1, 0, maxnum); 181 | int res = (int)tmp[0]; 182 | while (res == n_ex) 183 | { 184 | tmp = Rcpp::runif(1, 0, maxnum); 185 | res = (int)tmp[0]; 186 | } 187 | return res; 188 | } 189 | 190 | bool check_dupl_multilevel(Rcpp::IntegerVector vec) 191 | { 192 | int n = vec.size(); 193 | bool res = false; 194 | for (int i = 0; i < n - 1; ++i) 195 | { 196 | if (vec[i] == vec[i+1]) 197 | { 198 | res = true; 199 | break; 200 | } 201 | } 202 | return res; 203 | } 204 | 205 | bool compare_pairsecond_multilevel(std::pair x, std::pair y) 206 | { 207 | return x.second > y.second; 208 | } 209 | 210 | Rcpp::IntegerVector generate_newpos_multilevel(int j, int sn, int n_thres, int n, Rcpp::IntegerMatrix prepos) 211 | { 212 | int tmpidx = generate_randint_multilevel(j, sn); 213 | Rcpp::NumericVector tmprand = Rcpp::runif(n_thres, -1, 1); 214 | Rcpp::IntegerVector newpos(n_thres); 215 | for (int k = 0; k < n_thres; ++k) 216 | { 217 | int tmppos = (int)(prepos(j,k) + tmprand[k] * (prepos(j,k) - prepos(tmpidx,k))); 218 | if (tmppos < 0) 219 | { 220 | tmppos = 0; 221 | } else if (tmppos >= n) 222 | { 223 | tmppos = n - 1; 224 | } 225 | newpos[k] = tmppos; 226 | } 227 | std::sort(newpos.begin(), newpos.end()); 228 | bool flag_dupl = check_dupl_multilevel(newpos); 229 | while (flag_dupl) 230 | { 231 | tmpidx = generate_randint_multilevel(j, sn); 232 | tmprand = Rcpp::runif(n_thres, -1, 1); 233 | for (int k = 0; k < n_thres; ++k) 234 | { 235 | int tmppos = (int)(prepos(j,k) + tmprand[k] * (prepos(j,k) - prepos(tmpidx,k))); 236 | if (tmppos < 0) 237 | { 238 | tmppos = 0; 239 | } else if (tmppos >= n) 240 | { 241 | tmppos = n - 1; 242 | } 243 | newpos[k] = tmppos; 244 | } 245 | std::sort(newpos.begin(), newpos.end()); 246 | flag_dupl = check_dupl_multilevel(newpos); 247 | } 248 | return newpos; 249 | } 250 | 251 | // [[Rcpp::export]] 252 | Rcpp::IntegerVector get_threshold_multilevel(Rcpp::NumericVector im_density, Rcpp::NumericVector im_integral_density, int n_thres, int sn, int mcn, int limit) 253 | { 254 | int n = im_density.size(); 255 | if (n != im_integral_density.size()) 256 | { 257 | Rcpp::Rcout << "The length of im_density is not same as the length of im_integral_density." << std::endl; 258 | } 259 | Rcpp::IntegerVector gbest(n_thres); 260 | Rcpp::IntegerMatrix prepos(sn, n_thres); 261 | double gbeste = 0.0; 262 | Rcpp::NumericVector prepe(sn); 263 | Rcpp::IntegerVector ptrail(sn); 264 | Rcpp::IntegerVector pflags(sn); 265 | 266 | // step 1. generate initial position 267 | for (int i = 0; i < sn; ++i) 268 | { 269 | Rcpp::IntegerVector tmpvec = generate_inipos_multilevel(n_thres, n); 270 | for (int j = 0; j < n_thres; ++j) 271 | { 272 | prepos(i,j) = tmpvec[j]; 273 | } 274 | prepe[i] = calculate_entropy_multilevel(im_density, im_integral_density, tmpvec); 275 | if (prepe[i] >= gbeste) 276 | { 277 | gbeste = prepe[i]; 278 | for (int j = 0; j < n_thres; ++j) 279 | { 280 | gbest[j] = prepos(i,j); 281 | } 282 | } 283 | } 284 | 285 | for (int cycle = 0; cycle < mcn; ++cycle) 286 | { 287 | // step 2. place the employed bees 288 | for (int j = 0; j < sn; ++j) 289 | { 290 | Rcpp::IntegerVector newpos = generate_newpos_multilevel(j, sn, n_thres, n, prepos); 291 | double newpose = calculate_entropy_multilevel(im_density, im_integral_density, newpos); 292 | if (newpose >= prepe[j]) 293 | { 294 | pflags[j] = 1; 295 | prepe[j] = newpose; 296 | for (int l = 0; l < n_thres; ++l) 297 | { 298 | prepos(j,l) = newpos[l]; 299 | } 300 | } 301 | } 302 | 303 | // step 3. Send the outlooker bees (sorting of vector of pair enable us to ----) 304 | double sum_entropy = 0.0; 305 | for (int i = 0; i < sn; ++i) 306 | { 307 | sum_entropy += prepe[i]; 308 | } 309 | std::vector > probs(sn); 310 | for (int i = 0; i < sn; ++i) 311 | { 312 | probs[i].first = i; 313 | if (sum_entropy != 0.0) 314 | { 315 | probs[i].second = prepe[i] / sum_entropy; 316 | } else 317 | { 318 | probs[i].second = 0.0; 319 | } 320 | } 321 | std::sort(probs.begin(), probs.end(), compare_pairsecond_multilevel); 322 | for (int i = 0; i < sn; ++i) 323 | { 324 | Rcpp::NumericVector temprand = Rcpp::runif(1, 0, 1); 325 | for (int j = 0; j < sn; ++j) 326 | { 327 | if (temprand[0] < probs[j].second) 328 | { 329 | Rcpp::IntegerVector newpos = generate_newpos_multilevel(probs[j].first, sn, n_thres, n, prepos); 330 | double newpose = calculate_entropy_multilevel(im_density, im_integral_density, newpos); 331 | if (newpose >= prepe[j]) 332 | { 333 | pflags[j] = 1; 334 | prepe[j] = newpose; 335 | for (int l = 0; l < n_thres; ++l) 336 | { 337 | prepos(j,l) = newpos[l]; 338 | } 339 | } 340 | break; 341 | } 342 | } 343 | } 344 | 345 | // step 4. Send the scounts 346 | for (int i = 0; i < sn; ++i) 347 | { 348 | if (pflags[i] == 0) 349 | { 350 | ptrail[i] += 1; 351 | } 352 | } 353 | double flag_scout = false; 354 | for (int i = 0; i < sn; ++i) 355 | { 356 | if (ptrail[i] > limit) 357 | { 358 | flag_scout = true; 359 | break; 360 | } 361 | } 362 | if (flag_scout) 363 | { 364 | Rcpp::IntegerVector pmax(n_thres); 365 | Rcpp::IntegerVector pmin(n_thres); 366 | for (int i = 0; i < n_thres; ++i) 367 | { 368 | pmax[i] = prepos(0,i); 369 | pmin[i] = prepos(0,i); 370 | } 371 | for (int i = 1; i < sn; ++i) 372 | { 373 | for (int j = 0; j < n_thres; ++j) 374 | { 375 | if (prepos(i,j) > pmax[j]) 376 | { 377 | pmax[j] = prepos(i,j); 378 | } 379 | if (prepos(i,j) < pmin[j]) 380 | { 381 | pmin[j] = prepos(i,j); 382 | } 383 | } 384 | } 385 | for (int i = 0; i < sn; ++i) 386 | { 387 | if (ptrail[i] > limit) 388 | { 389 | Rcpp::IntegerVector newpos(n_thres); 390 | Rcpp::NumericVector tmpunif = Rcpp::runif(n_thres, 0, 1); 391 | for (int j = 0; j < n_thres; ++j) 392 | { 393 | int tmppos = (int)(prepos(i,j) + tmpunif[j] * (pmax[j] - pmin[j])); 394 | if (tmppos < 0) 395 | { 396 | tmppos = 0; 397 | } else if (tmppos >= n) 398 | { 399 | tmppos = n - 1; 400 | } 401 | newpos[j] = tmppos; 402 | } 403 | std::sort(newpos.begin(), newpos.end()); 404 | bool flag_dupl = check_dupl_multilevel(newpos); 405 | while (flag_dupl) 406 | { 407 | tmpunif = Rcpp::runif(n_thres, 0, 1); 408 | for (int j = 0; j < n_thres; ++j) 409 | { 410 | int tmppos = (int)(prepos(i,j) + tmpunif[j] * (pmax[j] - pmin[j])); 411 | if (tmppos < 0) 412 | { 413 | tmppos = 0; 414 | } else if (tmppos >= n) 415 | { 416 | tmppos = n - 1; 417 | } 418 | newpos[j] = tmppos; 419 | } 420 | std::sort(newpos.begin(), newpos.end()); 421 | flag_dupl = check_dupl_multilevel(newpos); 422 | } 423 | double newpose = calculate_entropy_multilevel(im_density, im_integral_density, newpos); 424 | if (newpose >= prepe[i]) 425 | { 426 | ptrail[i] = 0; 427 | prepe[i] = newpose; 428 | for (int l = 0; l < n_thres; ++l) 429 | { 430 | prepos(i,l) = newpos[l]; 431 | } 432 | } 433 | } 434 | } 435 | } 436 | 437 | // step 5. Record the best solution 438 | for (int i = 0; i < sn; ++i) 439 | { 440 | if (prepe[i] >= gbeste) 441 | { 442 | gbeste = prepe[i]; 443 | for (int j = 0; j < n_thres; ++j) 444 | { 445 | gbest[j] = prepos(i,j); 446 | } 447 | } 448 | } 449 | 450 | } 451 | for (int i = 0; i < n_thres; ++i) 452 | { 453 | gbest[i] += 1; 454 | } 455 | return gbest; 456 | } 457 | 458 | // [[Rcpp::export]] 459 | Rcpp::NumericMatrix threshold_multilevel(Rcpp::NumericMatrix im, Rcpp::NumericVector thresvals) 460 | { 461 | int nrow = im.nrow(); 462 | int ncol = im.ncol(); 463 | int n_thres = thresvals.size(); 464 | Rcpp::NumericMatrix res(nrow, ncol); 465 | for (int i = 0; i < nrow; ++i) 466 | { 467 | for (int j = 0; j < ncol; ++j) 468 | { 469 | bool flag = true; 470 | for (int k = 0; k < n_thres; ++k) 471 | { 472 | if (im(i,j) <= thresvals[k]) 473 | { 474 | flag = false; 475 | res(i,j) = k; 476 | break; 477 | } 478 | } 479 | if (flag) 480 | { 481 | res(i,j) = n_thres; 482 | } 483 | } 484 | } 485 | return res; 486 | } -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | 6 | using namespace Rcpp; 7 | 8 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 9 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 10 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 11 | #endif 12 | 13 | // DCTdenoising 14 | Rcpp::NumericMatrix DCTdenoising(Rcpp::NumericMatrix ipixelsR, int width, int height, double sigma, int flag_dct16x16); 15 | RcppExport SEXP _imagerExtra_DCTdenoising(SEXP ipixelsRSEXP, SEXP widthSEXP, SEXP heightSEXP, SEXP sigmaSEXP, SEXP flag_dct16x16SEXP) { 16 | BEGIN_RCPP 17 | Rcpp::RObject rcpp_result_gen; 18 | Rcpp::RNGScope rcpp_rngScope_gen; 19 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type ipixelsR(ipixelsRSEXP); 20 | Rcpp::traits::input_parameter< int >::type width(widthSEXP); 21 | Rcpp::traits::input_parameter< int >::type height(heightSEXP); 22 | Rcpp::traits::input_parameter< double >::type sigma(sigmaSEXP); 23 | Rcpp::traits::input_parameter< int >::type flag_dct16x16(flag_dct16x16SEXP); 24 | rcpp_result_gen = Rcpp::wrap(DCTdenoising(ipixelsR, width, height, sigma, flag_dct16x16)); 25 | return rcpp_result_gen; 26 | END_RCPP 27 | } 28 | // make_histogram_ADPHE 29 | Rcpp::NumericVector make_histogram_ADPHE(const Rcpp::NumericVector& ordered, const Rcpp::NumericVector& interval); 30 | RcppExport SEXP _imagerExtra_make_histogram_ADPHE(SEXP orderedSEXP, SEXP intervalSEXP) { 31 | BEGIN_RCPP 32 | Rcpp::RObject rcpp_result_gen; 33 | Rcpp::RNGScope rcpp_rngScope_gen; 34 | Rcpp::traits::input_parameter< const Rcpp::NumericVector& >::type ordered(orderedSEXP); 35 | Rcpp::traits::input_parameter< const Rcpp::NumericVector& >::type interval(intervalSEXP); 36 | rcpp_result_gen = Rcpp::wrap(make_histogram_ADPHE(ordered, interval)); 37 | return rcpp_result_gen; 38 | END_RCPP 39 | } 40 | // find_local_maximum_ADPHE 41 | Rcpp::NumericVector find_local_maximum_ADPHE(const Rcpp::NumericVector& hist, int n); 42 | RcppExport SEXP _imagerExtra_find_local_maximum_ADPHE(SEXP histSEXP, SEXP nSEXP) { 43 | BEGIN_RCPP 44 | Rcpp::RObject rcpp_result_gen; 45 | Rcpp::RNGScope rcpp_rngScope_gen; 46 | Rcpp::traits::input_parameter< const Rcpp::NumericVector& >::type hist(histSEXP); 47 | Rcpp::traits::input_parameter< int >::type n(nSEXP); 48 | rcpp_result_gen = Rcpp::wrap(find_local_maximum_ADPHE(hist, n)); 49 | return rcpp_result_gen; 50 | END_RCPP 51 | } 52 | // modify_histogram_ADPHE 53 | Rcpp::NumericVector modify_histogram_ADPHE(const Rcpp::NumericVector& imhist, double t_down, double t_up); 54 | RcppExport SEXP _imagerExtra_modify_histogram_ADPHE(SEXP imhistSEXP, SEXP t_downSEXP, SEXP t_upSEXP) { 55 | BEGIN_RCPP 56 | Rcpp::RObject rcpp_result_gen; 57 | Rcpp::RNGScope rcpp_rngScope_gen; 58 | Rcpp::traits::input_parameter< const Rcpp::NumericVector& >::type imhist(imhistSEXP); 59 | Rcpp::traits::input_parameter< double >::type t_down(t_downSEXP); 60 | Rcpp::traits::input_parameter< double >::type t_up(t_upSEXP); 61 | rcpp_result_gen = Rcpp::wrap(modify_histogram_ADPHE(imhist, t_down, t_up)); 62 | return rcpp_result_gen; 63 | END_RCPP 64 | } 65 | // histogram_equalization_ADPHE 66 | Rcpp::NumericVector histogram_equalization_ADPHE(const Rcpp::NumericMatrix& im, const Rcpp::NumericVector& interval2, const Rcpp::NumericVector& imhist_modified, double min_range, double max_range); 67 | RcppExport SEXP _imagerExtra_histogram_equalization_ADPHE(SEXP imSEXP, SEXP interval2SEXP, SEXP imhist_modifiedSEXP, SEXP min_rangeSEXP, SEXP max_rangeSEXP) { 68 | BEGIN_RCPP 69 | Rcpp::RObject rcpp_result_gen; 70 | Rcpp::RNGScope rcpp_rngScope_gen; 71 | Rcpp::traits::input_parameter< const Rcpp::NumericMatrix& >::type im(imSEXP); 72 | Rcpp::traits::input_parameter< const Rcpp::NumericVector& >::type interval2(interval2SEXP); 73 | Rcpp::traits::input_parameter< const Rcpp::NumericVector& >::type imhist_modified(imhist_modifiedSEXP); 74 | Rcpp::traits::input_parameter< double >::type min_range(min_rangeSEXP); 75 | Rcpp::traits::input_parameter< double >::type max_range(max_rangeSEXP); 76 | rcpp_result_gen = Rcpp::wrap(histogram_equalization_ADPHE(im, interval2, imhist_modified, min_range, max_range)); 77 | return rcpp_result_gen; 78 | END_RCPP 79 | } 80 | // ChanVeseInitPhi 81 | Rcpp::NumericMatrix ChanVeseInitPhi(int Width, int Height); 82 | RcppExport SEXP _imagerExtra_ChanVeseInitPhi(SEXP WidthSEXP, SEXP HeightSEXP) { 83 | BEGIN_RCPP 84 | Rcpp::RObject rcpp_result_gen; 85 | Rcpp::RNGScope rcpp_rngScope_gen; 86 | Rcpp::traits::input_parameter< int >::type Width(WidthSEXP); 87 | Rcpp::traits::input_parameter< int >::type Height(HeightSEXP); 88 | rcpp_result_gen = Rcpp::wrap(ChanVeseInitPhi(Width, Height)); 89 | return rcpp_result_gen; 90 | END_RCPP 91 | } 92 | // ChanVeseInitPhi_Rect 93 | Rcpp::NumericMatrix ChanVeseInitPhi_Rect(int Width, int Height, Rcpp::IntegerVector rect); 94 | RcppExport SEXP _imagerExtra_ChanVeseInitPhi_Rect(SEXP WidthSEXP, SEXP HeightSEXP, SEXP rectSEXP) { 95 | BEGIN_RCPP 96 | Rcpp::RObject rcpp_result_gen; 97 | Rcpp::RNGScope rcpp_rngScope_gen; 98 | Rcpp::traits::input_parameter< int >::type Width(WidthSEXP); 99 | Rcpp::traits::input_parameter< int >::type Height(HeightSEXP); 100 | Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type rect(rectSEXP); 101 | rcpp_result_gen = Rcpp::wrap(ChanVeseInitPhi_Rect(Width, Height, rect)); 102 | return rcpp_result_gen; 103 | END_RCPP 104 | } 105 | // ChanVese 106 | Rcpp::List ChanVese(Rcpp::NumericMatrix im, double Mu, double Nu, double Lambda1, double Lambda2, double tol, int maxiter, double dt, Rcpp::NumericMatrix phi); 107 | RcppExport SEXP _imagerExtra_ChanVese(SEXP imSEXP, SEXP MuSEXP, SEXP NuSEXP, SEXP Lambda1SEXP, SEXP Lambda2SEXP, SEXP tolSEXP, SEXP maxiterSEXP, SEXP dtSEXP, SEXP phiSEXP) { 108 | BEGIN_RCPP 109 | Rcpp::RObject rcpp_result_gen; 110 | Rcpp::RNGScope rcpp_rngScope_gen; 111 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type im(imSEXP); 112 | Rcpp::traits::input_parameter< double >::type Mu(MuSEXP); 113 | Rcpp::traits::input_parameter< double >::type Nu(NuSEXP); 114 | Rcpp::traits::input_parameter< double >::type Lambda1(Lambda1SEXP); 115 | Rcpp::traits::input_parameter< double >::type Lambda2(Lambda2SEXP); 116 | Rcpp::traits::input_parameter< double >::type tol(tolSEXP); 117 | Rcpp::traits::input_parameter< int >::type maxiter(maxiterSEXP); 118 | Rcpp::traits::input_parameter< double >::type dt(dtSEXP); 119 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type phi(phiSEXP); 120 | rcpp_result_gen = Rcpp::wrap(ChanVese(im, Mu, Nu, Lambda1, Lambda2, tol, maxiter, dt, phi)); 121 | return rcpp_result_gen; 122 | END_RCPP 123 | } 124 | // DCT2D_reorder 125 | Rcpp::NumericMatrix DCT2D_reorder(Rcpp::NumericMatrix mat); 126 | RcppExport SEXP _imagerExtra_DCT2D_reorder(SEXP matSEXP) { 127 | BEGIN_RCPP 128 | Rcpp::RObject rcpp_result_gen; 129 | Rcpp::RNGScope rcpp_rngScope_gen; 130 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type mat(matSEXP); 131 | rcpp_result_gen = Rcpp::wrap(DCT2D_reorder(mat)); 132 | return rcpp_result_gen; 133 | END_RCPP 134 | } 135 | // DCT2D_fromDFT 136 | Rcpp::NumericMatrix DCT2D_fromDFT(Rcpp::ComplexMatrix mat); 137 | RcppExport SEXP _imagerExtra_DCT2D_fromDFT(SEXP matSEXP) { 138 | BEGIN_RCPP 139 | Rcpp::RObject rcpp_result_gen; 140 | Rcpp::RNGScope rcpp_rngScope_gen; 141 | Rcpp::traits::input_parameter< Rcpp::ComplexMatrix >::type mat(matSEXP); 142 | rcpp_result_gen = Rcpp::wrap(DCT2D_fromDFT(mat)); 143 | return rcpp_result_gen; 144 | END_RCPP 145 | } 146 | // IDCT2D_toDFT 147 | Rcpp::ComplexMatrix IDCT2D_toDFT(Rcpp::NumericMatrix mat); 148 | RcppExport SEXP _imagerExtra_IDCT2D_toDFT(SEXP matSEXP) { 149 | BEGIN_RCPP 150 | Rcpp::RObject rcpp_result_gen; 151 | Rcpp::RNGScope rcpp_rngScope_gen; 152 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type mat(matSEXP); 153 | rcpp_result_gen = Rcpp::wrap(IDCT2D_toDFT(mat)); 154 | return rcpp_result_gen; 155 | END_RCPP 156 | } 157 | // IDCT2D_retrievex 158 | Rcpp::NumericMatrix IDCT2D_retrievex(Rcpp::NumericMatrix mat); 159 | RcppExport SEXP _imagerExtra_IDCT2D_retrievex(SEXP matSEXP) { 160 | BEGIN_RCPP 161 | Rcpp::RObject rcpp_result_gen; 162 | Rcpp::RNGScope rcpp_rngScope_gen; 163 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type mat(matSEXP); 164 | rcpp_result_gen = Rcpp::wrap(IDCT2D_retrievex(mat)); 165 | return rcpp_result_gen; 166 | END_RCPP 167 | } 168 | // make_histogram_fuzzy 169 | Rcpp::NumericVector make_histogram_fuzzy(Rcpp::NumericVector ordered, Rcpp::NumericVector interval); 170 | RcppExport SEXP _imagerExtra_make_histogram_fuzzy(SEXP orderedSEXP, SEXP intervalSEXP) { 171 | BEGIN_RCPP 172 | Rcpp::RObject rcpp_result_gen; 173 | Rcpp::RNGScope rcpp_rngScope_gen; 174 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type ordered(orderedSEXP); 175 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type interval(intervalSEXP); 176 | rcpp_result_gen = Rcpp::wrap(make_histogram_fuzzy(ordered, interval)); 177 | return rcpp_result_gen; 178 | END_RCPP 179 | } 180 | // fuzzy_threshold 181 | double fuzzy_threshold(Rcpp::NumericVector imhist, Rcpp::NumericVector interval, int n, int maxiter, double omegamax, double omegamin, double c1, double c2, double mutrate, double vmax, int localsearch); 182 | RcppExport SEXP _imagerExtra_fuzzy_threshold(SEXP imhistSEXP, SEXP intervalSEXP, SEXP nSEXP, SEXP maxiterSEXP, SEXP omegamaxSEXP, SEXP omegaminSEXP, SEXP c1SEXP, SEXP c2SEXP, SEXP mutrateSEXP, SEXP vmaxSEXP, SEXP localsearchSEXP) { 183 | BEGIN_RCPP 184 | Rcpp::RObject rcpp_result_gen; 185 | Rcpp::RNGScope rcpp_rngScope_gen; 186 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type imhist(imhistSEXP); 187 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type interval(intervalSEXP); 188 | Rcpp::traits::input_parameter< int >::type n(nSEXP); 189 | Rcpp::traits::input_parameter< int >::type maxiter(maxiterSEXP); 190 | Rcpp::traits::input_parameter< double >::type omegamax(omegamaxSEXP); 191 | Rcpp::traits::input_parameter< double >::type omegamin(omegaminSEXP); 192 | Rcpp::traits::input_parameter< double >::type c1(c1SEXP); 193 | Rcpp::traits::input_parameter< double >::type c2(c2SEXP); 194 | Rcpp::traits::input_parameter< double >::type mutrate(mutrateSEXP); 195 | Rcpp::traits::input_parameter< double >::type vmax(vmaxSEXP); 196 | Rcpp::traits::input_parameter< int >::type localsearch(localsearchSEXP); 197 | rcpp_result_gen = Rcpp::wrap(fuzzy_threshold(imhist, interval, n, maxiter, omegamax, omegamin, c1, c2, mutrate, vmax, localsearch)); 198 | return rcpp_result_gen; 199 | END_RCPP 200 | } 201 | // make_prob_otsu 202 | Rcpp::NumericVector make_prob_otsu(Rcpp::NumericVector ordered, Rcpp::NumericVector bins, int intervalnumber, int width, int height); 203 | RcppExport SEXP _imagerExtra_make_prob_otsu(SEXP orderedSEXP, SEXP binsSEXP, SEXP intervalnumberSEXP, SEXP widthSEXP, SEXP heightSEXP) { 204 | BEGIN_RCPP 205 | Rcpp::RObject rcpp_result_gen; 206 | Rcpp::RNGScope rcpp_rngScope_gen; 207 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type ordered(orderedSEXP); 208 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type bins(binsSEXP); 209 | Rcpp::traits::input_parameter< int >::type intervalnumber(intervalnumberSEXP); 210 | Rcpp::traits::input_parameter< int >::type width(widthSEXP); 211 | Rcpp::traits::input_parameter< int >::type height(heightSEXP); 212 | rcpp_result_gen = Rcpp::wrap(make_prob_otsu(ordered, bins, intervalnumber, width, height)); 213 | return rcpp_result_gen; 214 | END_RCPP 215 | } 216 | // get_th_otsu 217 | double get_th_otsu(Rcpp::NumericVector prob_otsu, Rcpp::NumericVector bins); 218 | RcppExport SEXP _imagerExtra_get_th_otsu(SEXP prob_otsuSEXP, SEXP binsSEXP) { 219 | BEGIN_RCPP 220 | Rcpp::RObject rcpp_result_gen; 221 | Rcpp::RNGScope rcpp_rngScope_gen; 222 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type prob_otsu(prob_otsuSEXP); 223 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type bins(binsSEXP); 224 | rcpp_result_gen = Rcpp::wrap(get_th_otsu(prob_otsu, bins)); 225 | return rcpp_result_gen; 226 | END_RCPP 227 | } 228 | // threshold_adaptive 229 | Rcpp::NumericMatrix threshold_adaptive(Rcpp::NumericMatrix mat, double k, int windowsize, double maxsd); 230 | RcppExport SEXP _imagerExtra_threshold_adaptive(SEXP matSEXP, SEXP kSEXP, SEXP windowsizeSEXP, SEXP maxsdSEXP) { 231 | BEGIN_RCPP 232 | Rcpp::RObject rcpp_result_gen; 233 | Rcpp::RNGScope rcpp_rngScope_gen; 234 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type mat(matSEXP); 235 | Rcpp::traits::input_parameter< double >::type k(kSEXP); 236 | Rcpp::traits::input_parameter< int >::type windowsize(windowsizeSEXP); 237 | Rcpp::traits::input_parameter< double >::type maxsd(maxsdSEXP); 238 | rcpp_result_gen = Rcpp::wrap(threshold_adaptive(mat, k, windowsize, maxsd)); 239 | return rcpp_result_gen; 240 | END_RCPP 241 | } 242 | // make_density_multilevel 243 | Rcpp::NumericVector make_density_multilevel(Rcpp::NumericVector ordered, Rcpp::NumericVector interval); 244 | RcppExport SEXP _imagerExtra_make_density_multilevel(SEXP orderedSEXP, SEXP intervalSEXP) { 245 | BEGIN_RCPP 246 | Rcpp::RObject rcpp_result_gen; 247 | Rcpp::RNGScope rcpp_rngScope_gen; 248 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type ordered(orderedSEXP); 249 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type interval(intervalSEXP); 250 | rcpp_result_gen = Rcpp::wrap(make_density_multilevel(ordered, interval)); 251 | return rcpp_result_gen; 252 | END_RCPP 253 | } 254 | // make_integral_density_multilevel 255 | Rcpp::NumericVector make_integral_density_multilevel(Rcpp::NumericVector density); 256 | RcppExport SEXP _imagerExtra_make_integral_density_multilevel(SEXP densitySEXP) { 257 | BEGIN_RCPP 258 | Rcpp::RObject rcpp_result_gen; 259 | Rcpp::RNGScope rcpp_rngScope_gen; 260 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type density(densitySEXP); 261 | rcpp_result_gen = Rcpp::wrap(make_integral_density_multilevel(density)); 262 | return rcpp_result_gen; 263 | END_RCPP 264 | } 265 | // get_threshold_multilevel 266 | Rcpp::IntegerVector get_threshold_multilevel(Rcpp::NumericVector im_density, Rcpp::NumericVector im_integral_density, int n_thres, int sn, int mcn, int limit); 267 | RcppExport SEXP _imagerExtra_get_threshold_multilevel(SEXP im_densitySEXP, SEXP im_integral_densitySEXP, SEXP n_thresSEXP, SEXP snSEXP, SEXP mcnSEXP, SEXP limitSEXP) { 268 | BEGIN_RCPP 269 | Rcpp::RObject rcpp_result_gen; 270 | Rcpp::RNGScope rcpp_rngScope_gen; 271 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type im_density(im_densitySEXP); 272 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type im_integral_density(im_integral_densitySEXP); 273 | Rcpp::traits::input_parameter< int >::type n_thres(n_thresSEXP); 274 | Rcpp::traits::input_parameter< int >::type sn(snSEXP); 275 | Rcpp::traits::input_parameter< int >::type mcn(mcnSEXP); 276 | Rcpp::traits::input_parameter< int >::type limit(limitSEXP); 277 | rcpp_result_gen = Rcpp::wrap(get_threshold_multilevel(im_density, im_integral_density, n_thres, sn, mcn, limit)); 278 | return rcpp_result_gen; 279 | END_RCPP 280 | } 281 | // threshold_multilevel 282 | Rcpp::NumericMatrix threshold_multilevel(Rcpp::NumericMatrix im, Rcpp::NumericVector thresvals); 283 | RcppExport SEXP _imagerExtra_threshold_multilevel(SEXP imSEXP, SEXP thresvalsSEXP) { 284 | BEGIN_RCPP 285 | Rcpp::RObject rcpp_result_gen; 286 | Rcpp::RNGScope rcpp_rngScope_gen; 287 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type im(imSEXP); 288 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type thresvals(thresvalsSEXP); 289 | rcpp_result_gen = Rcpp::wrap(threshold_multilevel(im, thresvals)); 290 | return rcpp_result_gen; 291 | END_RCPP 292 | } 293 | // piecewise_transformation 294 | Rcpp::NumericVector piecewise_transformation(Rcpp::NumericVector data, Rcpp::NumericVector F, int N, double smax, double smin, double max, double min, double max_range, double min_range); 295 | RcppExport SEXP _imagerExtra_piecewise_transformation(SEXP dataSEXP, SEXP FSEXP, SEXP NSEXP, SEXP smaxSEXP, SEXP sminSEXP, SEXP maxSEXP, SEXP minSEXP, SEXP max_rangeSEXP, SEXP min_rangeSEXP) { 296 | BEGIN_RCPP 297 | Rcpp::RObject rcpp_result_gen; 298 | Rcpp::RNGScope rcpp_rngScope_gen; 299 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type data(dataSEXP); 300 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type F(FSEXP); 301 | Rcpp::traits::input_parameter< int >::type N(NSEXP); 302 | Rcpp::traits::input_parameter< double >::type smax(smaxSEXP); 303 | Rcpp::traits::input_parameter< double >::type smin(sminSEXP); 304 | Rcpp::traits::input_parameter< double >::type max(maxSEXP); 305 | Rcpp::traits::input_parameter< double >::type min(minSEXP); 306 | Rcpp::traits::input_parameter< double >::type max_range(max_rangeSEXP); 307 | Rcpp::traits::input_parameter< double >::type min_range(min_rangeSEXP); 308 | rcpp_result_gen = Rcpp::wrap(piecewise_transformation(data, F, N, smax, smin, max, min, max_range, min_range)); 309 | return rcpp_result_gen; 310 | END_RCPP 311 | } 312 | // screened_poisson_dct 313 | Rcpp::NumericMatrix screened_poisson_dct(Rcpp::NumericMatrix data, double L); 314 | RcppExport SEXP _imagerExtra_screened_poisson_dct(SEXP dataSEXP, SEXP LSEXP) { 315 | BEGIN_RCPP 316 | Rcpp::RObject rcpp_result_gen; 317 | Rcpp::RNGScope rcpp_rngScope_gen; 318 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type data(dataSEXP); 319 | Rcpp::traits::input_parameter< double >::type L(LSEXP); 320 | rcpp_result_gen = Rcpp::wrap(screened_poisson_dct(data, L)); 321 | return rcpp_result_gen; 322 | END_RCPP 323 | } 324 | // saturateim 325 | Rcpp::NumericVector saturateim(Rcpp::NumericVector data, double max_im, double min_im, double max_range, double min_range); 326 | RcppExport SEXP _imagerExtra_saturateim(SEXP dataSEXP, SEXP max_imSEXP, SEXP min_imSEXP, SEXP max_rangeSEXP, SEXP min_rangeSEXP) { 327 | BEGIN_RCPP 328 | Rcpp::RObject rcpp_result_gen; 329 | Rcpp::RNGScope rcpp_rngScope_gen; 330 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type data(dataSEXP); 331 | Rcpp::traits::input_parameter< double >::type max_im(max_imSEXP); 332 | Rcpp::traits::input_parameter< double >::type min_im(min_imSEXP); 333 | Rcpp::traits::input_parameter< double >::type max_range(max_rangeSEXP); 334 | Rcpp::traits::input_parameter< double >::type min_range(min_rangeSEXP); 335 | rcpp_result_gen = Rcpp::wrap(saturateim(data, max_im, min_im, max_range, min_range)); 336 | return rcpp_result_gen; 337 | END_RCPP 338 | } 339 | 340 | static const R_CallMethodDef CallEntries[] = { 341 | {"_imagerExtra_DCTdenoising", (DL_FUNC) &_imagerExtra_DCTdenoising, 5}, 342 | {"_imagerExtra_make_histogram_ADPHE", (DL_FUNC) &_imagerExtra_make_histogram_ADPHE, 2}, 343 | {"_imagerExtra_find_local_maximum_ADPHE", (DL_FUNC) &_imagerExtra_find_local_maximum_ADPHE, 2}, 344 | {"_imagerExtra_modify_histogram_ADPHE", (DL_FUNC) &_imagerExtra_modify_histogram_ADPHE, 3}, 345 | {"_imagerExtra_histogram_equalization_ADPHE", (DL_FUNC) &_imagerExtra_histogram_equalization_ADPHE, 5}, 346 | {"_imagerExtra_ChanVeseInitPhi", (DL_FUNC) &_imagerExtra_ChanVeseInitPhi, 2}, 347 | {"_imagerExtra_ChanVeseInitPhi_Rect", (DL_FUNC) &_imagerExtra_ChanVeseInitPhi_Rect, 3}, 348 | {"_imagerExtra_ChanVese", (DL_FUNC) &_imagerExtra_ChanVese, 9}, 349 | {"_imagerExtra_DCT2D_reorder", (DL_FUNC) &_imagerExtra_DCT2D_reorder, 1}, 350 | {"_imagerExtra_DCT2D_fromDFT", (DL_FUNC) &_imagerExtra_DCT2D_fromDFT, 1}, 351 | {"_imagerExtra_IDCT2D_toDFT", (DL_FUNC) &_imagerExtra_IDCT2D_toDFT, 1}, 352 | {"_imagerExtra_IDCT2D_retrievex", (DL_FUNC) &_imagerExtra_IDCT2D_retrievex, 1}, 353 | {"_imagerExtra_make_histogram_fuzzy", (DL_FUNC) &_imagerExtra_make_histogram_fuzzy, 2}, 354 | {"_imagerExtra_fuzzy_threshold", (DL_FUNC) &_imagerExtra_fuzzy_threshold, 11}, 355 | {"_imagerExtra_make_prob_otsu", (DL_FUNC) &_imagerExtra_make_prob_otsu, 5}, 356 | {"_imagerExtra_get_th_otsu", (DL_FUNC) &_imagerExtra_get_th_otsu, 2}, 357 | {"_imagerExtra_threshold_adaptive", (DL_FUNC) &_imagerExtra_threshold_adaptive, 4}, 358 | {"_imagerExtra_make_density_multilevel", (DL_FUNC) &_imagerExtra_make_density_multilevel, 2}, 359 | {"_imagerExtra_make_integral_density_multilevel", (DL_FUNC) &_imagerExtra_make_integral_density_multilevel, 1}, 360 | {"_imagerExtra_get_threshold_multilevel", (DL_FUNC) &_imagerExtra_get_threshold_multilevel, 6}, 361 | {"_imagerExtra_threshold_multilevel", (DL_FUNC) &_imagerExtra_threshold_multilevel, 2}, 362 | {"_imagerExtra_piecewise_transformation", (DL_FUNC) &_imagerExtra_piecewise_transformation, 9}, 363 | {"_imagerExtra_screened_poisson_dct", (DL_FUNC) &_imagerExtra_screened_poisson_dct, 2}, 364 | {"_imagerExtra_saturateim", (DL_FUNC) &_imagerExtra_saturateim, 5}, 365 | {NULL, NULL, 0} 366 | }; 367 | 368 | RcppExport void R_init_imagerExtra(DllInfo *dll) { 369 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 370 | R_useDynamicSymbols(dll, FALSE); 371 | } 372 | --------------------------------------------------------------------------------