R/RcppExports.R

In dahtah/imager: Image Processing Library Based on 'CImg'

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' @describeIn imager.colourspaces RGB to HSL conversion 
#' @export
RGBtoHSL <- function(im) {
    .Call(`_imager_RGBtoHSL`, im)
}

#' @describeIn imager.colourspaces CIE RGB to CIE XYZ (1931) conversion, D65 white point
#' @export
RGBtoXYZ <- function(im) {
    .Call(`_imager_RGBtoXYZ`, im)
}

#' @describeIn imager.colourspaces CIE XYZ to CIE RGB (1931) conversion, D65 white point
#' @export
XYZtoRGB <- function(im) {
    .Call(`_imager_XYZtoRGB`, im)
}

#' @describeIn imager.colourspaces HSL to RGB conversion 
#' @export
HSLtoRGB <- function(im) {
    .Call(`_imager_HSLtoRGB`, im)
}

#' @describeIn imager.colourspaces RGB to HSV conversion 
#' @export
RGBtoHSV <- function(im) {
    .Call(`_imager_RGBtoHSV`, im)
}

#' @describeIn imager.colourspaces HSV to RGB conversion 
#' @export
HSVtoRGB <- function(im) {
    .Call(`_imager_HSVtoRGB`, im)
}

#' @describeIn imager.colourspaces RGB to HSI conversion 
#' @export
RGBtoHSI <- function(im) {
    .Call(`_imager_RGBtoHSI`, im)
}

#' @describeIn imager.colourspaces HSI to RGB conversion 
#' @export
HSItoRGB <- function(im) {
    .Call(`_imager_HSItoRGB`, im)
}

#' @describeIn imager.colourspaces RGB to sRGB conversion 
#' @export
RGBtosRGB <- function(im) {
    .Call(`_imager_RGBtosRGB`, im)
}

#' @describeIn imager.colourspaces sRGB to RGB conversion 
#' @export
sRGBtoRGB <- function(im) {
    .Call(`_imager_sRGBtoRGB`, im)
}

#' @describeIn imager.colourspaces RGB to YCbCr conversion 
#' @export
RGBtoYCbCr <- function(im) {
    .Call(`_imager_RGBtoYCbCr`, im)
}

#' @describeIn imager.colourspaces YCbCr to RGB conversion 
#' @export
YCbCrtoRGB <- function(im) {
    .Call(`_imager_YCbCrtoRGB`, im)
}

#' @describeIn imager.colourspaces RGB to YUV conversion 
#' @export
RGBtoYUV <- function(im) {
    .Call(`_imager_RGBtoYUV`, im)
}

#' @describeIn imager.colourspaces YUV to RGB conversion 
#' @export
YUVtoRGB <- function(im) {
    .Call(`_imager_YUVtoRGB`, im)
}

#' @describeIn imager.colourspaces Lab to RGB (linear)
#' @export
LabtoRGB <- function(im) {
    .Call(`_imager_LabtoRGB`, im)
}

#' @describeIn imager.colourspaces RGB (linear) to Lab
#' @export
RGBtoLab <- function(im) {
    .Call(`_imager_RGBtoLab`, im)
}

#' @describeIn imager.colourspaces Lab to XYZ
#' @export
LabtoXYZ <- function(im) {
    .Call(`_imager_LabtoXYZ`, im)
}

#' @describeIn imager.colourspaces XYZ to Lab
#' @export
XYZtoLab <- function(im) {
    .Call(`_imager_XYZtoLab`, im)
}

#' @describeIn imager.colourspaces Lab to sRGB
#' @export
LabtosRGB <- function(im) {
    .Call(`_imager_LabtosRGB`, im)
}

#' @describeIn imager.colourspaces sRGB to Lab
#' @export
sRGBtoLab <- function(im) {
    .Call(`_imager_sRGBtoLab`, im)
}

getXc <- function(x, y, z, c) {
    .Call(`_imager_getXc`, x, y, z, c)
}

getYc <- function(x, y, z, c) {
    .Call(`_imager_getYc`, x, y, z, c)
}

getZc <- function(x, y, z, c) {
    .Call(`_imager_getZc`, x, y, z, c)
}

getCc <- function(x, y, z, c) {
    .Call(`_imager_getCc`, x, y, z, c)
}

display_ <- function(im, rescale = TRUE) {
    invisible(.Call(`_imager_display_`, im, rescale))
}

display_list <- function(imlist) {
    invisible(.Call(`_imager_display_list`, imlist))
}

#' Play a video 
#'
#' A very basic video player. Press the space bar to pause and ESC to close. Note that you need X11 library to use this function.
#' @param vid A cimg object, to be played as video
#' @param loop loop the video (default false)
#' @param delay delay between frames, in ms. Default 30.
#' @param normalise if true pixel values are rescaled to 0...255 (default TRUE). The normalisation is based on the *first frame*. If you don't want the default behaviour you can normalise by hand. Default TRUE.
#' @export
play <- function(vid, loop = FALSE, delay = 30L, normalise = TRUE) {
    invisible(.Call(`_imager_play`, vid, loop, delay, normalise))
}

select <- function(im, type = 2L) {
    .Call(`_imager_select`, im, type)
}

bucket_fill <- function(im, x, y, z, color, opacity = 1, sigma = 0, high_connexity = FALSE) {
    .Call(`_imager_bucket_fill`, im, x, y, z, color, opacity, sigma, high_connexity)
}

bucket_select <- function(im, x, y, z, sigma = 0, high_connexity = FALSE) {
    .Call(`_imager_bucket_select`, im, x, y, z, sigma, high_connexity)
}

draw_circle <- function(im, x, y, radius, color, opacity = 1, filled = TRUE) {
    .Call(`_imager_draw_circle`, im, x, y, radius, color, opacity, filled)
}

draw_circle_ <- function(im, x, y, radius, color, opacity = 1L, filled = TRUE) {
    .Call(`_imager_draw_circle_`, im, x, y, radius, color, opacity, filled)
}

draw_rect_ <- function(im, x0, y0, x1, y1, color, opacity = 1, filled = TRUE) {
    .Call(`_imager_draw_rect_`, im, x0, y0, x1, y1, color, opacity, filled)
}

draw_poly_ <- function(im, points, color, opacity = 1) {
    .Call(`_imager_draw_poly_`, im, points, color, opacity)
}

draw_text_ <- function(im, x, y, text, color, opacity = 1, fsize = 20L) {
    .Call(`_imager_draw_text_`, im, x, y, text, color, opacity, fsize)
}

#' Apply recursive Deriche filter.
#'
#' The Deriche filter is a fast approximation to a Gaussian filter (order = 0), or Gaussian derivatives (order = 1 or 2).   
#' 
#' @param im an image
#' @param sigma Standard deviation of the filter.
#' @param order Order of the filter. 0 for a smoothing filter, 1 for first-derivative, 2 for second.
#' @param axis Axis along which the filter is computed ( 'x' , 'y', 'z' or 'c').
#' @param neumann If true, use Neumann boundary conditions (default false, Dirichlet)
#' @export
#' @examples
#' deriche(boats,sigma=2,order=0) %>% plot("Zeroth-order Deriche along x")
#' deriche(boats,sigma=2,order=1) %>% plot("First-order Deriche along x")
#' deriche(boats,sigma=2,order=1) %>% plot("Second-order Deriche along x")
#' deriche(boats,sigma=2,order=1,axis="y") %>% plot("Second-order Deriche along y")
deriche <- function(im, sigma, order = 0L, axis = 'x', neumann = FALSE) {
    .Call(`_imager_deriche`, im, sigma, order, axis, neumann)
}

#' Young-Van Vliet recursive Gaussian filter.
#'
#' The Young-van Vliet filter is a fast approximation to a Gaussian filter (order = 0), or Gaussian derivatives (order = 1 or 2).   
#'
#' @param im an image
#' @param sigma standard deviation of the Gaussian filter
#' @param order the order of the filter 0,1,2,3
#' @param axis  Axis along which the filter is computed. One of 'x', 'y', 'z', 'c'
#' @param neumann If true, use Neumann boundary conditions (default false, Dirichlet)
#' @references
#'       From: I.T. Young, L.J. van Vliet, M. van Ginkel, Recursive Gabor filtering.
#'       IEEE Trans. Sig. Proc., vol. 50, pp. 2799-2805, 2002.
#'       (this is an improvement over Young-Van Vliet, Sig. Proc. 44, 1995)
#'
#'       Boundary conditions (only for order 0) using Triggs matrix, from
#'       B. Triggs and M. Sdika. Boundary conditions for Young-van Vliet
#'       recursive filtering. IEEE Trans. Signal Processing,
#'       vol. 54, pp. 2365-2367, 2006.
#' @examples
#' vanvliet(boats,sigma=2,order=0) %>% plot("Zeroth-order Young-van Vliet along x")
#' vanvliet(boats,sigma=2,order=1) %>% plot("First-order Young-van Vliet along x")
#' vanvliet(boats,sigma=2,order=1) %>% plot("Second-order Young-van Vliet along x")
#' vanvliet(boats,sigma=2,order=1,axis="y") %>% plot("Second-order Young-van Vliet along y")
#' @export
vanvliet <- function(im, sigma, order = 0L, axis = 'x', neumann = FALSE) {
    .Call(`_imager_vanvliet`, im, sigma, order, axis, neumann)
}

isoblur_ <- function(im, sigma, neumann = TRUE, gaussian = FALSE) {
    .Call(`_imager_isoblur_`, im, sigma, neumann, gaussian)
}

#' Blur image with the median filter.
#'    
#' In a window of size n x n centered at pixel (x,y), compute median pixel value over the window. Optionally, ignore values that are too far from the value at current pixel.  
#'
#' @param im an image
#' @param n Size of the median filter.
#' @param threshold Threshold used to discard pixels too far from the current pixel value in the median computation. Can be used for edge-preserving smoothing. Default 0 (include all pixels in window).
#' @export
#' @examples
#' medianblur(boats,5) %>% plot(main="Median blur, 5 pixels")
#' medianblur(boats,10) %>% plot(main="Median blur, 10 pixels")
#' medianblur(boats,10,8) %>% plot(main="Median blur, 10 pixels, threshold = 8")
#' @seealso isoblur, boxblur
medianblur <- function(im, n, threshold = 0) {
    .Call(`_imager_medianblur`, im, n, threshold)
}

#' Blur image with a box filter (square window)
#' @param im an image
#' @param boxsize Size of the box window (can be subpixel).
#' @param neumann If true, use Neumann boundary conditions, Dirichlet otherwise  (default true, Neumann)
#' @seealso deriche(), vanvliet().
#' @examples
#' boxblur(boats,5) %>% plot(main="Dirichlet boundary")
#' boxblur(boats,5,TRUE) %>% plot(main="Neumann boundary")
#' @export
boxblur <- function(im, boxsize, neumann = TRUE) {
    .Call(`_imager_boxblur`, im, boxsize, neumann)
}

#' Compute image Laplacian
#'
#' The Laplacian is the sum of second derivatives, approximated here using finite differences.
#' @param im an image
#' @examples
#' imlap(boats) %>% plot
#' @export
imlap <- function(im) {
    .Call(`_imager_imlap`, im)
}

#' Blur image with a box filter.
#'
#' This is a recursive algorithm, not depending on the values of the box kernel size.
#'
#' @param im an image
#' @param sx Size of the box window, along the X-axis.
#' @param sy Size of the box window, along the Y-axis.
#' @param neumann If true, use Neumann boundary conditions, Dirichlet otherwise  (default true, Neumann)
#' @seealso blur().
#'
#' @export
#' @examples
#' boxblur_xy(boats,20,5) %>% plot(main="Anisotropic blur")
boxblur_xy <- function(im, sx, sy, neumann = TRUE) {
    .Call(`_imager_boxblur_xy`, im, sx, sy, neumann)
}

#' Correlation/convolution of image by filter
#'
#'  The correlation of image im by filter flt is defined as:
#'  \eqn{res(x,y,z) = sum_{i,j,k} im(x + i,y + j,z + k)*flt(i,j,k).}
#'  The convolution of an image img by filter flt is defined to be:
#'       \eqn{res(x,y,z) = sum_{i,j,k} img(x-i,y-j,z-k)*flt(i,j,k)}
#'
#' @param im an image
#' @param filter the correlation kernel.
#' @param dirichlet boundary condition. Dirichlet if true, Neumann if false (default TRUE, Dirichlet)
#' @param normalise compute a normalised correlation (ie. local cosine similarity)
#'      
#'
#' @export
#' @examples
#' #Edge filter
#' filter <- as.cimg(function(x,y) sign(x-5),10,10) 
#' layout(t(1:2))
#' #Convolution vs. correlation 
#' correlate(boats,filter) %>% plot(main="Correlation")
#' convolve(boats,filter) %>% plot(main="Convolution")
correlate <- function(im, filter, dirichlet = TRUE, normalise = FALSE) {
    .Call(`_imager_correlate`, im, filter, dirichlet, normalise)
}

#' @describeIn correlate convolve image with filter
#' @export
convolve <- function(im, filter, dirichlet = TRUE, normalise = FALSE) {
    .Call(`_imager_convolve`, im, filter, dirichlet, normalise)
}

sharpen <- function(im, amplitude, sharpen_type = FALSE, edge = 1, alpha = 0, sigma = 0) {
    .Call(`_imager_sharpen`, im, amplitude, sharpen_type, edge, alpha, sigma)
}

#' Compute image gradient.
#'
#' @param im an image
#' @param axes Axes considered for the gradient computation, as a C-string (e.g "xy").
#' @param scheme = Numerical scheme used for the gradient computation:
#'       1 = Backward finite differences
#'       0 = Centered finite differences
#'       1 = Forward finite differences
#'       2 = Using Sobel masks
#'       3 = Using rotation invariant masks
#'       4 = Using Deriche recursive filter.
#'       5 = Using Van Vliet recursive filter.
#' @return a list of images (corresponding to the different directions)
#' @export
#' @seealso imgradient
get_gradient <- function(im, axes = "", scheme = 3L) {
    .Call(`_imager_get_gradient`, im, axes, scheme)
}

#' Return image hessian.
#' @param im an image
#' @param axes Axes considered for the hessian computation, as a character string (e.g "xy").
get_hessian <- function(im, axes = "") {
    .Call(`_imager_get_hessian`, im, axes)
}

#' Compute field of diffusion tensors for edge-preserving smoothing.
#'
#' @param im an image
#' @param sharpness Sharpness
#' @param anisotropy Anisotropy
#' @param alpha Standard deviation of the gradient blur.
#' @param sigma Standard deviation of the structure tensor blur.
#' @param is_sqrt Tells if the square root of the tensor field is computed instead.
#' @export
diffusion_tensors <- function(im, sharpness = 0.7, anisotropy = 0.6, alpha = 0.6, sigma = 1.1, is_sqrt = FALSE) {
    .Call(`_imager_diffusion_tensors`, im, sharpness, anisotropy, alpha, sigma, is_sqrt)
}

#' Compute Haar multiscale wavelet transform.
#'
#' @param im an image
#' @param inverse Compute inverse transform (default FALSE)
#' @param nb_scales Number of scales used for the transform.
#' @export
#' @examples
#' #Image compression: set small Haar coefficients to 0
#' hr <- haar(boats,nb=3) 
#' mask.low <- threshold(abs(hr),"75%")
#' mask.high <- threshold(abs(hr),"95%")
#' haar(hr*mask.low,inverse=TRUE,nb=3) %>% plot(main="75% compression")
#' haar(hr*mask.high,inverse=TRUE,nb=3) %>% plot(main="95% compression")
haar <- function(im, inverse = FALSE, nb_scales = 1L) {
    .Call(`_imager_haar`, im, inverse, nb_scales)
}

FFT_complex <- function(real, imag, inverse = FALSE, nb_threads = 0L) {
    .Call(`_imager_FFT_complex`, real, imag, inverse, nb_threads)
}

FFT_realim <- function(real, inverse = FALSE, nb_threads = 0L) {
    .Call(`_imager_FFT_realim`, real, inverse, nb_threads)
}

FFT_realout <- function(real, imag, inverse = FALSE, nb_threads = 0L) {
    .Call(`_imager_FFT_realout`, real, imag, inverse, nb_threads)
}

#' Estimate displacement field between two images.
#'
#' @param sourceIm Reference image.
#' @param destIm Reference image.
#' @param smoothness Smoothness of estimated displacement field.
#' @param precision Precision required for algorithm convergence.
#' @param nb_scales Number of scales used to estimate the displacement field.
#' @param iteration_max Maximum number of iterations allowed for one scale.
#' @param is_backward If false, match I2(X + U(X)) = I1(X), else match I2(X) = I1(X - U(X)).
#' @export
displacement <- function(sourceIm, destIm, smoothness = 0.1, precision = 5.0, nb_scales = 0L, iteration_max = 10000L, is_backward = FALSE) {
    .Call(`_imager_displacement`, sourceIm, destIm, smoothness, precision, nb_scales, iteration_max, is_backward)
}

#' Blur image anisotropically, in an edge-preserving way.
#' 
#' Standard blurring removes noise from images, but tends to smooth away edges in the process. This anisotropic filter preserves edges better. 
#' 
#' @param im an image
#' @param amplitude Amplitude of the smoothing.
#' @param sharpness Sharpness.
#' @param anisotropy Anisotropy.
#' @param alpha Standard deviation of the gradient blur.
#' @param sigma Standard deviation of the structure tensor blur.
#' @param dl Spatial discretization.
#' @param da Angular discretization.
#' @param gauss_prec Precision of the diffusion process.
#' @param interpolation_type Interpolation scheme.
#'  Can be 0=nearest-neighbor | 1=linear | 2=Runge-Kutta 
#' @param fast_approx If true, use fast approximation (default TRUE)
#' @export
#' @examples
#' im <- load.image(system.file('extdata/Leonardo_Birds.jpg',package='imager'))
#' im.noisy <- (im + 80*rnorm(prod(dim(im)))) 
#' blur_anisotropic(im.noisy,ampl=1e4,sharp=1) %>% plot
blur_anisotropic <- function(im, amplitude, sharpness = 0.7, anisotropy = 0.6, alpha = 0.6, sigma = 1.1, dl = 0.8, da = 30, gauss_prec = 2, interpolation_type = 0L, fast_approx = TRUE) {
    .Call(`_imager_blur_anisotropic`, im, amplitude, sharpness, anisotropy, alpha, sigma, dl, da, gauss_prec, interpolation_type, fast_approx)
}

periodic_part <- function(im) {
    .Call(`_imager_periodic_part`, im)
}

hough_line_px <- function(px, theta) {
    .Call(`_imager_hough_line_px`, px, theta)
}

hough_line_grad <- function(im, ntheta, alpha = 1.5) {
    .Call(`_imager_hough_line_grad`, im, ntheta, alpha)
}

hough_circle_ <- function(px, radius) {
    .Call(`_imager_hough_circle_`, px, radius)
}

bgraph <- function(px) {
    .Call(`_imager_bgraph`, px)
}

interact_ <- function(fun, init, title = "") {
    .Call(`_imager_interact_`, fun, init, title)
}

interp_xy <- function(inp, ix, iy, z = 0L, c = 0L, cubic = FALSE) {
    .Call(`_imager_interp_xy`, inp, ix, iy, z, c, cubic)
}

interp_xyz <- function(inp, ix, iy, iz, c = 0L, cubic = FALSE) {
    .Call(`_imager_interp_xyz`, inp, ix, iy, iz, c, cubic)
}

interp_xyzc <- function(inp, ix, iy, iz, ic, cubic = FALSE) {
    .Call(`_imager_interp_xyzc`, inp, ix, iy, iz, ic, cubic)
}

interp_xyc <- function(inp, ix, iy, z, ic, cubic = FALSE) {
    .Call(`_imager_interp_xyc`, inp, ix, iy, z, ic, cubic)
}

#' Label connected components.
#'
#' The algorithm of connected components computation has been primarily done
#'by A. Meijster, according to the publication:
#''W.H. Hesselink, A. Meijster, C. Bron, "Concurrent Determination of Connected Components.",
#'       In: Science of Computer Programming 41 (2001), pp. 173--194'.
#'
#' @param im an image
#' @param high_connectivity   4(false)- or 8(true)-connectivity
#'       in 2d case, and between 6(false)- or 26(true)-connectivity in 3d case. Default FALSE
#' @param tolerance Tolerance used to determine if two neighboring pixels belong to the same region.
#' @export
#' @examples
#' imname <- system.file('extdata/parrots.png',package='imager')
#' im <- load.image(imname) %>% grayscale
#' #Thresholding yields different discrete regions of high intensity
#' regions <- isoblur(im,10) %>% threshold("97%") 
#' labels <- label(regions)
#' layout(t(1:2))
#' plot(regions,"Regions")
#' plot(labels,"Labels")
#' 
label <- function(im, high_connectivity = FALSE, tolerance = 0) {
    .Call(`_imager_label`, im, high_connectivity, tolerance)
}

blabel <- function(im, high_connectivity = FALSE) {
    .Call(`_imager_blabel`, im, high_connectivity)
}

#' Erode/dilate image by a structuring element.
#'
#' @param im an image
#' @param size size of the structuring element.
#' @param mask Structuring element.
#' @param boundary_conditions Boundary conditions. If FALSE, pixels beyond image boundaries are considered to be 0, if TRUE one. Default: TRUE.
#' @param real_mode If TRUE, perform erosion as defined on the reals. If FALSE, perform binary erosion (default FALSE).
#' @export
#' @examples
#' fname <- system.file('extdata/Leonardo_Birds.jpg',package='imager')
#' im <- load.image(fname) %>% grayscale
#' outline <- threshold(-im,"95%")
#' plot(outline)
#' mask <- imfill(5,10,val=1) #Rectangular mask
#' plot(erode(outline,mask))
#' plot(erode_rect(outline,5,10)) #Same thing
#' plot(erode_square(outline,5)) 
#' plot(dilate(outline,mask))
#' plot(dilate_rect(outline,5,10))
#' plot(dilate_square(outline,5)) 
erode <- function(im, mask, boundary_conditions = TRUE, real_mode = FALSE) {
    .Call(`_imager_erode`, im, mask, boundary_conditions, real_mode)
}

berode <- function(im, mask, boundary_conditions = TRUE) {
    .Call(`_imager_berode`, im, mask, boundary_conditions)
}

#' @describeIn erode Erode image by a rectangular structuring element of specified size.
#' @param sx Width of the structuring element.
#' @param sy Height of the structuring element.
#' @param sz Depth of the structuring element.
#' @export
erode_rect <- function(im, sx, sy, sz = 1L) {
    .Call(`_imager_erode_rect`, im, sx, sy, sz)
}

berode_rect <- function(im, sx, sy, sz = 1L) {
    .Call(`_imager_berode_rect`, im, sx, sy, sz)
}

#' @describeIn erode Erode image by a square structuring element of specified size.
#'
#' @export
erode_square <- function(im, size) {
    .Call(`_imager_erode_square`, im, size)
}

berode_square <- function(im, size) {
    .Call(`_imager_berode_square`, im, size)
}

#' @describeIn erode Dilate image by a structuring element.
#' @export
dilate <- function(im, mask, boundary_conditions = TRUE, real_mode = FALSE) {
    .Call(`_imager_dilate`, im, mask, boundary_conditions, real_mode)
}

bdilate <- function(im, mask, boundary_conditions = TRUE) {
    .Call(`_imager_bdilate`, im, mask, boundary_conditions)
}

#' @describeIn erode Dilate image by a rectangular structuring element of specified size
#' @export
dilate_rect <- function(im, sx, sy, sz = 1L) {
    .Call(`_imager_dilate_rect`, im, sx, sy, sz)
}

bdilate_rect <- function(im, sx, sy, sz = 1L) {
    .Call(`_imager_bdilate_rect`, im, sx, sy, sz)
}

#' @describeIn erode Dilate image by a square structuring element of specified size
#' @export
dilate_square <- function(im, size) {
    .Call(`_imager_dilate_square`, im, size)
}

bdilate_square <- function(im, size) {
    .Call(`_imager_bdilate_square`, im, size)
}

#' Compute watershed transform.
#'
#' The watershed transform is a label propagation algorithm. The value of non-zero pixels will get propagated to their zero-value neighbours. The propagation is controlled by a priority map. See examples. 
#' @param im an image
#' @param priority Priority map.
#' @param fill_lines Sets if watershed lines must be filled or not.
#' @examples
#' #In our initial image we'll place three seeds 
#' #(non-zero pixels) at various locations, with values 1, 2 and 3. 
#' #We'll use the watershed algorithm to propagate these values
#' imd <- function(x,y) imdirac(c(100,100,1,1),x,y)
#' im <- imd(20,20)+2*imd(40,40)+3*imd(80,80)
#' layout(t(1:3))
#' plot(im,main="Seed image")
#' #Now we build an priority map: neighbours of our seeds 
#' #should get high priority. 
#' #We'll use a distance map for that
#' p <- 1-distance_transform(sign(im),1) 
#' plot(p,main="Priority map")
#' watershed(im,p) %>% plot(main="Watershed transform")
#' @export
watershed <- function(im, priority, fill_lines = TRUE) {
    .Call(`_imager_watershed`, im, priority, fill_lines)
}

#' Compute Euclidean distance function to a specified value.
#'
#'        The distance transform implementation has been submitted by A. Meijster, and implements
#'        the article 'W.H. Hesselink, A. Meijster, J.B.T.M. Roerdink,
#'                     "A general algorithm for computing distance transforms in linear time.",
#'                     In: Mathematical Morphology and its Applications to Image and Signal Processing,
#'                     J. Goutsias, L. Vincent, and D.S. Bloomberg (eds.), Kluwer, 2000, pp. 331-340.'
#'         The submitted code has then been modified to fit CImg coding style and constraints.
#' @param im an image
#' @param value Reference value.
#' @param metric Type of metric. Can be <tt>{ 0=Chebyshev | 1=Manhattan | 2=Euclidean | 3=Squared-euclidean }</tt>.
#' @export
#' @examples
#' imd <- function(x,y) imdirac(c(100,100,1,1),x,y)
#' #Image is three white dots
#' im <- imd(20,20)+imd(40,40)+imd(80,80)
#' plot(im)
#' #How far are we from the nearest white dot? 
#' distance_transform(im,1) %>% plot
distance_transform <- function(im, value, metric = 2L) {
    .Call(`_imager_distance_transform`, im, value, metric)
}

bdistance_transform <- function(im, value = TRUE, metric = 2L) {
    .Call(`_imager_bdistance_transform`, im, value, metric)
}

#' @describeIn erode Morphological opening (erosion followed by dilation)
#' @export
mopening <- function(im, mask, boundary_conditions = TRUE, real_mode = FALSE) {
    .Call(`_imager_mopening`, im, mask, boundary_conditions, real_mode)
}

#' @describeIn erode Morphological opening by a square element (erosion followed by dilation)
#' @export
mopening_square <- function(im, size) {
    .Call(`_imager_mopening_square`, im, size)
}

#' @describeIn erode Morphological closing by a square element (dilation followed by erosion)
#' @export
mclosing_square <- function(im, size) {
    .Call(`_imager_mclosing_square`, im, size)
}

#' @describeIn erode Morphological closing (dilation followed by erosion)
#' @export
mclosing <- function(im, mask, boundary_conditions = TRUE, real_mode = FALSE) {
    .Call(`_imager_mclosing`, im, mask, boundary_conditions, real_mode)
}

reduce_wsum <- function(x, w, na_rm = FALSE) {
    .Call(`_imager_reduce_wsum`, x, w, na_rm)
}

reduce_average <- function(x, na_rm = FALSE) {
    .Call(`_imager_reduce_average`, x, na_rm)
}

reduce_prod <- function(x, na_rm = FALSE) {
    .Call(`_imager_reduce_prod`, x, na_rm)
}

reduce_minmax <- function(x, na_rm = FALSE, max = TRUE) {
    .Call(`_imager_reduce_minmax`, x, na_rm, max)
}

reduce_list <- function(x, summary = 0L) {
    .Call(`_imager_reduce_list`, x, summary)
}

reduce_list2 <- function(x, summary = 0L) {
    .Call(`_imager_reduce_list2`, x, summary)
}

reduce_med <- function(x, na_rm = FALSE) {
    .Call(`_imager_reduce_med`, x, na_rm)
}

psort <- function(x, increasing = TRUE) {
    .Call(`_imager_psort`, x, increasing)
}

porder <- function(x, increasing = TRUE) {
    .Call(`_imager_porder`, x, increasing)
}

prank <- function(x, increasing = TRUE) {
    .Call(`_imager_prank`, x, increasing)
}

autocrop_ <- function(im, color, axes = "zyx") {
    .Call(`_imager_autocrop_`, im, color, axes)
}

rotate <- function(im, angle, interpolation = 1L, boundary = 0L) {
    .Call(`_imager_rotate`, im, angle, interpolation, boundary)
}

#' Rotate image by an arbitrary angle, around a center point.
#'
#' @param im an image
#' @param angle Rotation angle, in degrees.
#' @param cx X-coordinate of the rotation center.
#' @param cy Y-coordinate of the rotation center.
#' @param interpolation Interpolation type. 0=nearest | 1=linear | 2=cubic 
#' @param boundary_conditions Boundary conditions. 0=dirichlet | 1=neumann | 2=periodic 
#' @examples
#' rotate_xy(boats,30,200,400) %>% plot
#' rotate_xy(boats,30,200,400,boundary=2) %>% plot
#' @export
rotate_xy <- function(im, angle, cx, cy, interpolation = 1L, boundary_conditions = 0L) {
    .Call(`_imager_rotate_xy`, im, angle, cx, cy, interpolation, boundary_conditions)
}

#' Mirror image content along specified axis 
#' @param im an image
#' @param axis Mirror axis ("x","y","z","c")
#' @export
#' @examples
#' mirror(boats,"x") %>% plot
#' mirror(boats,"y") %>% plot
mirror <- function(im, axis) {
    .Call(`_imager_mirror`, im, axis)
}

#' Permute image axes
#' 
#' By default images are stored in xyzc order. Use permute_axes to change that order. 
#' @param im an image
#' @param perm a character string, e.g., "zxyc" to have the z-axis come first
#' @export
#' @examples
#' im <- array(0,c(10,30,40,3)) %>% as.cimg
#' permute_axes(im,"zxyc")
permute_axes <- function(im, perm) {
    .Call(`_imager_permute_axes`, im, perm)
}

#' @describeIn resize_uniform Double size
#' @export
resize_doubleXY <- function(im) {
    .Call(`_imager_resize_doubleXY`, im)
}

#' @describeIn resize_uniform Half size
#' @export
resize_halfXY <- function(im) {
    .Call(`_imager_resize_halfXY`, im)
}

#' @describeIn resize_uniform Triple size
#' @export
resize_tripleXY <- function(im) {
    .Call(`_imager_resize_tripleXY`, im)
}

#' Shift image content.
#'
#' @param im an image
#' @param delta_x Amount of displacement along the X-axis.
#' @param delta_y Amount of displacement along the Y-axis.
#' @param delta_z Amount of displacement along the Z-axis.
#' @param delta_c Amount of displacement along the C-axis.
#' @param boundary_conditions can be:
#'          - 0: Zero border condition (Dirichlet).
#'          - 1: Nearest neighbors (Neumann).
#'          - 2: Repeat Pattern (Fourier style).
#' @export
#' @examples
#' imshift(boats,10,50) %>% plot
imshift <- function(im, delta_x = 0L, delta_y = 0L, delta_z = 0L, delta_c = 0L, boundary_conditions = 0L) {
    .Call(`_imager_imshift`, im, delta_x, delta_y, delta_z, delta_c, boundary_conditions)
}

#' Resize image
#'
#' If the dimension arguments are negative, they are interpreted as a proportion of the original image. 
#' @param im an image
#' @param size_x Number of columns (new size along the X-axis).
#' @param size_y Number of rows (new size along the Y-axis).
#' @param size_z Number of slices (new size along the Z-axis).
#' @param size_c Number of vector-channels (new size along the C-axis).
#' @param interpolation_type Method of interpolation:
#' -1 = no interpolation: raw memory resizing.
#' 0 = no interpolation: additional space is filled according to  boundary_conditions.
#' 1 = nearest-neighbor interpolation.
#' 2 = moving average interpolation.
#' 3 = linear interpolation.
#' 4 = grid interpolation.
#' 5 = cubic interpolation.
#' 6 = lanczos interpolation.
#' @param boundary_conditions Border condition type.
#' @param centering_x Set centering type (only if  interpolation_type=0).
#' @param centering_y Set centering type (only if  interpolation_type=0).
#' @param centering_z Set centering type (only if  interpolation_type=0).
#' @param centering_c Set centering type (only if  interpolation_type=0).
#' @seealso See imresize for an easier interface. 
#' @export
resize <- function(im, size_x = -100L, size_y = -100L, size_z = -100L, size_c = -100L, interpolation_type = 1L, boundary_conditions = 0L, centering_x = 0, centering_y = 0, centering_z = 0, centering_c = 0) {
    .Call(`_imager_resize`, im, size_x, size_y, size_z, size_c, interpolation_type, boundary_conditions, centering_x, centering_y, centering_z, centering_c)
}

#' Warp image
#'
#' @param im an image
#' @param warpfield Warping field. The (x,y,z) fields should be stacked along the colour coordinate. 
#' @param mode Can be { 0=backward-absolute | 1=backward-relative | 2=forward-absolute | 3=forward-relative }
#' @param interpolation Can be <tt>{ 0=nearest | 1=linear | 2=cubic }</tt>.
#' @param boundary_conditions Boundary conditions. Can be <tt>{ 0=dirichlet | 1=neumann | 2=periodic }</tt>.
#' @seealso imwarp for a user-friendly interface 
#' @export
#' @examples
#' #Shift image via warp
#' warp.x <- imfill(width(boats),height(boats),val=5)
#' warp.y <- imfill(width(boats),height(boats),val=20)
#' warpfield <- list(warp.x,warp.y) %>% imappend("c")
#' warp(boats,warpfield,mode=1) %>% plot
warp <- function(im, warpfield, mode = 0L, interpolation = 1L, boundary_conditions = 0L) {
    .Call(`_imager_warp`, im, warpfield, mode, interpolation, boundary_conditions)
}

load_image <- function(fname) {
    .Call(`_imager_load_image`, fname)
}

save_image <- function(im, fname) {
    invisible(.Call(`_imager_save_image`, im, fname))
}

#' Split an image along a certain axis (producing a list)
#' 
#' @param im an image 
#' @param axis the axis along which to split (for example 'c')
#' @param nb number of objects to split into. 
#' if nb=-1 (the default) the maximum number of splits is used ie. split(im,"c") produces a list containing all individual colour channels
#' @seealso imappend (the reverse operation)
im_split <- function(im, axis, nb = -1L) {
    .Call(`_imager_im_split`, im, axis, nb)
}

im_append <- function(imlist, axis) {
    .Call(`_imager_im_append`, imlist, axis)
}

px_append <- function(imlist, axis) {
    .Call(`_imager_px_append`, imlist, axis)
}

#' Extract a numerical summary from image patches, using CImg's mini-language
#' Experimental feature. 
#' @param im an image
#' @param expr a CImg expression (as a string)
#' @param cx vector of x coordinates for patch centers 
#' @param cy vector of y coordinates for patch centers 
#' @param wx vector of coordinates for patch width 
#' @param wy vector of coordinates for patch height 
#' @examples
#' #Example: median filtering using patch_summary_cimg
#' #Center a patch at each pixel
#' im <- grayscale(boats)
#' patches <- pixel.grid(im)  %>% dplyr::mutate(w=3,h=3)
#' #Extract patch summary
#' out <- dplyr::mutate(patches,med=patch_summary_cimg(im,"ic",x,y,w,h))
#' as.cimg(out,v.name="med") %>% plot
#' @export
patch_summary_cimg <- function(im, expr, cx, cy, wx, wy) {
    .Call(`_imager_patch_summary_cimg`, im, expr, cx, cy, wx, wy)
}

extract_fast <- function(im, fun, cx, cy, wx, wy) {
    .Call(`_imager_extract_fast`, im, fun, cx, cy, wx, wy)
}

#' Extract image patches and return a list
#'
#' Patches are rectangular (cubic) image regions centered at cx,cy (cz) with width wx and height wy (opt. depth wz)
#' WARNINGS: 
#' - values outside of the image region are subject to boundary conditions. The default is to set them to 0 (Dirichlet), other boundary conditions are listed below. 
#' - widths and heights should be odd integers (they're rounded up otherwise). 
#' @param im an image
#' @param cx vector of x coordinates for patch centers 
#' @param cy vector of y coordinates for patch centers 
#' @param wx vector of patch widths (or single value)
#' @param wy vector of patch heights (or single value)
#' @param boundary_conditions integer. Can be 0 (Dirichlet, default), 1 (Neumann) 2 (Periodic) 3 (mirror). 
#' @return a list of image patches (cimg objects)
#' @export
#' @examples
#' #2 patches of size 5x5 located at (10,10) and (10,20)
#' extract_patches(boats,c(10,10),c(10,20),5,5)
extract_patches <- function(im, cx, cy, wx, wy, boundary_conditions = 0L) {
    .Call(`_imager_extract_patches`, im, cx, cy, wx, wy, boundary_conditions)
}

#' @param cz vector of z coordinates for patch centers 
#' @param wz vector of coordinates for patch depth
#' @describeIn extract_patches Extract 3D patches
#' @export
extract_patches3D <- function(im, cx, cy, cz, wx, wy, wz, boundary_conditions = 0L) {
    .Call(`_imager_extract_patches3D`, im, cx, cy, cz, wx, wy, wz, boundary_conditions)
}

draw_image <- function(im, sprite, x = 0L, y = 0L, z = 0L, opacity = 1) {
    .Call(`_imager_draw_image`, im, sprite, x, y, z, opacity)
}

do_patchmatch <- function(im1, im2, patch_width, patch_height, patch_depth, nb_iterations, nb_randoms, occ_penalization, guide) {
    .Call(`_imager_do_patchmatch`, im1, im2, patch_width, patch_height, patch_depth, nb_iterations, nb_randoms, occ_penalization, guide)
}

checkcoords <- function(x, y, z, c, d) {
    .Call(`_imager_checkcoords`, x, y, z, c, d)
}

cimg_omp <- function() {
    .Call(`_imager_cimg_omp`)
}

set_cimg_omp <- function(mode) {
    .Call(`_imager_set_cimg_omp`, mode)
}

has_omp <- function() {
    .Call(`_imager_has_omp`)
}

px_split <- function(im, axis, nb = -1L) {
    .Call(`_imager_px_split`, im, axis, nb)
}