diff --git a/bin/Main.ml b/bin/Main.ml index 4894b509..b1896d88 100644 --- a/bin/Main.ml +++ b/bin/Main.ml @@ -30,8 +30,10 @@ let main img1Path img2Path diffPath threshold outputDiffMask failOnLayoutChange Gc.set { (Gc.get ()) with - (* 128 MB *) - major_heap_increment = 128 * 1024 * 1024; + (* 16MB is a reasonable value for minor heap size *) + minor_heap_size = 2 * 1024 * 1024; + (* Double the minor heap *) + major_heap_increment = 2 * 1024 * 1024; (* Reasonable high value to reduce major GC frequency *) space_overhead = 500; (* Disable compaction *) diff --git a/io/bmp/Bmp.ml b/io/bmp/Bmp.ml index 7612ddc1..906df94c 100644 --- a/io/bmp/Bmp.ml +++ b/io/bmp/Bmp.ml @@ -9,11 +9,15 @@ module IO : Odiff.ImageIO.ImageIO = struct let width, height, data = ReadBmp.load filename in { width; height; image = data } - let readDirectPixel ~(x : int) ~(y : int) (img : t Odiff.ImageIO.img) = + let readRawPixel ~(x : int) ~(y : int) (img : t Odiff.ImageIO.img) = let image : data = img.image in Array1.unsafe_get image ((y * img.width) + x) [@@inline] + let readRawPixelAtOffset offset (img : t Odiff.ImageIO.img) = + Array1.unsafe_get img.image offset + [@@inline] + let setImgColor ~x ~y color (img : t Odiff.ImageIO.img) = let image : data = img.image in Array1.unsafe_set image ((y * img.width) + x) color diff --git a/io/jpg/Jpg.ml b/io/jpg/Jpg.ml index 14fe2d75..268ce695 100644 --- a/io/jpg/Jpg.ml +++ b/io/jpg/Jpg.ml @@ -9,8 +9,13 @@ module IO = struct let width, height, data = ReadJpg.read_jpeg_image filename in { width; height; image = { data } } - let readDirectPixel ~x ~y (img : t Odiff.ImageIO.img) = - Array1.unsafe_get img.image.data ((y * img.width) + x) + let readRawPixel ~x ~y (img : t Odiff.ImageIO.img) = + (Array1.unsafe_get img.image.data ((y * img.width) + x) [@inline.always]) + [@@inline] + + let readRawPixelAtOffset offset (img : t Odiff.ImageIO.img) = + Array1.unsafe_get img.image.data offset + [@@inline] let setImgColor ~x ~y color (img : t Odiff.ImageIO.img) = Array1.unsafe_set img.image.data ((y * img.width) + x) color diff --git a/io/png/Png.ml b/io/png/Png.ml index 3ee265ff..b96daac3 100644 --- a/io/png/Png.ml +++ b/io/png/Png.ml @@ -6,9 +6,14 @@ type data = (int32, int32_elt, c_layout) Array1.t module IO : Odiff.ImageIO.ImageIO = struct type t = data - let readDirectPixel ~(x : int) ~(y : int) (img : t Odiff.ImageIO.img) = + let readRawPixelAtOffset offset (img : t Odiff.ImageIO.img) = + Array1.unsafe_get img.image offset + [@@inline always] + + let readRawPixel ~(x : int) ~(y : int) (img : t Odiff.ImageIO.img) = let image : data = img.image in Array1.unsafe_get image ((y * img.width) + x) + [@@inline always] let setImgColor ~x ~y color (img : t Odiff.ImageIO.img) = let image : data = img.image in diff --git a/io/tiff/Tiff.ml b/io/tiff/Tiff.ml index ff89ea2f..141c6857 100644 --- a/io/tiff/Tiff.ml +++ b/io/tiff/Tiff.ml @@ -1,8 +1,9 @@ open Bigarray +open Odiff.ImageIO type data = (int32, int32_elt, c_layout) Array1.t -module IO : Odiff.ImageIO.ImageIO = struct +module IO : ImageIO = struct type buffer type t = { data : data } @@ -10,8 +11,11 @@ module IO : Odiff.ImageIO.ImageIO = struct let width, height, data = ReadTiff.load filename in { width; height; image = { data } } - let readDirectPixel ~(x : int) ~(y : int) (img : t Odiff.ImageIO.img) = - Array1.unsafe_get img.image.data ((y * img.width) + x) + let readRawPixel ~x ~y img = + (Array1.unsafe_get img.image.data ((y * img.width) + x) [@inline.always]) + + let readRawPixelAtOffset offset img = Array1.unsafe_get img.image.data offset + [@@inline.always] let setImgColor ~x ~y color (img : t Odiff.ImageIO.img) = Array1.unsafe_set img.image.data ((y * img.width) + x) color diff --git a/src/Antialiasing.ml b/src/Antialiasing.ml index 241cf505..b927fc0a 100644 --- a/src/Antialiasing.ml +++ b/src/Antialiasing.ml @@ -39,13 +39,11 @@ module MakeAntialiasing (IO1 : ImageIO.ImageIO) (IO2 : ImageIO.ImageIO) = struct | false -> 0) in - let baseColor = baseImg |> IO1.readDirectPixel ~x ~y in + let baseColor = baseImg |> IO1.readRawPixel ~x ~y in for adj_y = y0 to y1 do for adj_x = x0 to x1 do if !zeroes < 3 && (x <> adj_x || y <> adj_y) then - let adjacentColor = - baseImg |> IO1.readDirectPixel ~x:adj_x ~y:adj_y - in + let adjacentColor = baseImg |> IO1.readRawPixel ~x:adj_x ~y:adj_y in if baseColor = adjacentColor then incr zeroes else let delta = @@ -75,15 +73,11 @@ module MakeAntialiasing (IO1 : ImageIO.ImageIO) (IO2 : ImageIO.ImageIO) = struct let minX, minY = !minSiblingDeltaCoord in let maxX, maxY = !maxSiblingDeltaCoord in (hasManySiblingsWithSameColor ~x:minX ~y:minY ~width:baseImg.width - ~height:baseImg.height - ~readColor:(IO1.readDirectPixel baseImg) + ~height:baseImg.height ~readColor:(IO1.readRawPixel baseImg) || hasManySiblingsWithSameColor ~x:maxX ~y:maxY ~width:baseImg.width - ~height:baseImg.height - ~readColor:(IO1.readDirectPixel baseImg)) + ~height:baseImg.height ~readColor:(IO1.readRawPixel baseImg)) && (hasManySiblingsWithSameColor ~x:minX ~y:minY ~width:compImg.width - ~height:compImg.height - ~readColor:(IO2.readDirectPixel compImg) + ~height:compImg.height ~readColor:(IO2.readRawPixel compImg) || hasManySiblingsWithSameColor ~x:maxX ~y:maxY ~width:compImg.width - ~height:compImg.height - ~readColor:(IO2.readDirectPixel compImg)) + ~height:compImg.height ~readColor:(IO2.readRawPixel compImg)) end diff --git a/src/ColorDelta.ml b/src/ColorDelta.ml index 3e544c50..f12132cc 100644 --- a/src/ColorDelta.ml +++ b/src/ColorDelta.ml @@ -1,43 +1,53 @@ +open Int32 + +type pixel = { r : float; g : float; b : float; a : float } + +let white_pixel : pixel = { r = 255.; g = 255.; b = 255.; a = 0. } let blend_channel_white color alpha = 255. +. ((color -. 255.) *. alpha) -let white_pixel = (255., 255., 255., 0.) -let blendSemiTransparentColor = function - | r, g, b, 0. -> white_pixel - | r, g, b, 255. -> (r, g, b, 1.) - | r, g, b, alpha when alpha < 255. -> - let normalizedAlpha = alpha /. 255. in +let blendSemiTransparentPixel = function + | { r; g; b; a } when a = 0. -> white_pixel + | { r; g; b; a } when a = 255. -> { r; g; b; a = 1. } + | { r; g; b; a } when a < 255. -> + let normalizedAlpha = a /. 255. in let r, g, b, a = ( blend_channel_white r normalizedAlpha, blend_channel_white g normalizedAlpha, blend_channel_white b normalizedAlpha, normalizedAlpha ) in - (r, g, b, a) + + { r; g; b; a } | _ -> failwith "Found pixel with alpha value greater than uint8 max value. Aborting." -let convertPixelToFloat pixel = - let pixel = pixel |> Int32.to_int in - let a = (pixel lsr 24) land 255 in - let b = (pixel lsr 16) land 255 in - let g = (pixel lsr 8) land 255 in - let r = pixel land 255 in - - (Float.of_int r, Float.of_int g, Float.of_int b, Float.of_int a) - -let rgb2y (r, g, b, a) = +let decodeRawPixel pixel = + let a = logand (shift_right_logical pixel 24) 255l in + let b = logand (shift_right_logical pixel 16) 255l in + let g = logand (shift_right_logical pixel 8) 255l in + let r = logand pixel 255l in + + { + r = Int32.to_float r; + g = Int32.to_float g; + b = Int32.to_float b; + a = Int32.to_float a; + } +[@@inline] + +let rgb2y { r; g; b; a } = (r *. 0.29889531) +. (g *. 0.58662247) +. (b *. 0.11448223) -let rgb2i (r, g, b, a) = +let rgb2i { r; g; b; a } = (r *. 0.59597799) -. (g *. 0.27417610) -. (b *. 0.32180189) -let rgb2q (r, g, b, a) = +let rgb2q { r; g; b; a } = (r *. 0.21147017) -. (g *. 0.52261711) +. (b *. 0.31114694) -let calculatePixelColorDelta _pixelA _pixelB = - let pixelA = _pixelA |> convertPixelToFloat |> blendSemiTransparentColor in - let pixelB = _pixelB |> convertPixelToFloat |> blendSemiTransparentColor in +let calculatePixelColorDelta pixelA pixelB = + let pixelA = pixelA |> decodeRawPixel |> blendSemiTransparentPixel in + let pixelB = pixelB |> decodeRawPixel |> blendSemiTransparentPixel in let y = rgb2y pixelA -. rgb2y pixelB in let i = rgb2i pixelA -. rgb2i pixelB in @@ -47,6 +57,6 @@ let calculatePixelColorDelta _pixelA _pixelB = delta let calculatePixelBrightnessDelta pixelA pixelB = - let pixelA = pixelA |> convertPixelToFloat |> blendSemiTransparentColor in - let pixelB = pixelB |> convertPixelToFloat |> blendSemiTransparentColor in + let pixelA = pixelA |> decodeRawPixel |> blendSemiTransparentPixel in + let pixelB = pixelB |> decodeRawPixel |> blendSemiTransparentPixel in rgb2y pixelA -. rgb2y pixelB diff --git a/src/Diff.ml b/src/Diff.ml index ddb186dc..61d52869 100644 --- a/src/Diff.ml +++ b/src/Diff.ml @@ -1,3 +1,5 @@ +open Int32 + (* Decimal representation of the RGBA in32 pixel red pixel *) let redPixel = Int32.of_int 4278190335 @@ -6,14 +8,20 @@ let maxYIQPossibleDelta = 35215. type 'a diffVariant = Layout | Pixel of ('a * int * float * int Stack.t) -let computeIgnoreRegionOffsets width = - List.map (fun ((x1, y1), (x2, y2)) -> - let p1 = (y1 * width) + x1 in - let p2 = (y2 * width) + x2 in - (p1, p2)) +let unrollIgnoreRegions width list = + list + |> Option.map + (List.map (fun ((x1, y1), (x2, y2)) -> + let p1 = (y1 * width) + x1 in + let p2 = (y2 * width) + x2 in + (p1, p2))) -let isInIgnoreRegion offset = - List.exists (fun ((p1 : int), (p2 : int)) -> offset >= p1 && offset <= p2) +let isInIgnoreRegion offset list = + list + |> Option.map + (List.exists (fun ((p1 : int), (p2 : int)) -> + offset >= p1 && offset <= p2)) + |> Option.value ~default:false module MakeDiff (IO1 : ImageIO.ImageIO) (IO2 : ImageIO.ImageIO) = struct module BaseAA = Antialiasing.MakeAntialiasing (IO1) (IO2) @@ -21,7 +29,7 @@ module MakeDiff (IO1 : ImageIO.ImageIO) (IO2 : ImageIO.ImageIO) = struct let compare (base : IO1.t ImageIO.img) (comp : IO2.t ImageIO.img) ?(antialiasing = false) ?(outputDiffMask = false) ?(diffLines = false) - ?diffPixel ?(threshold = 0.1) ?(ignoreRegions = []) () = + ?diffPixel ?(threshold = 0.1) ~ignoreRegions () = let maxDelta = maxYIQPossibleDelta *. (threshold ** 2.) in let diffPixel = match diffPixel with Some x -> x | None -> redPixel in let diffOutput = @@ -42,30 +50,31 @@ module MakeDiff (IO1 : ImageIO.ImageIO) (IO2 : ImageIO.ImageIO) = struct then diffLinesStack |> Stack.push y in - let ignoreRegions = - ignoreRegions |> computeIgnoreRegionOffsets base.width - in + let ignoreRegions = unrollIgnoreRegions base.width ignoreRegions in + let hasIgnoreRegions = ignoreRegions |> Option.is_some in let size = (base.height * base.width) - 1 in let x = ref 0 in let y = ref 0 in for offset = 0 to size do + let baseColor = IO1.readRawPixelAtOffset offset base in + (if !x >= comp.width || !y >= comp.height then ( - let alpha = - (Int32.to_int (IO1.readDirectPixel ~x:!x ~y:!y base) lsr 24) land 255 - in - if alpha <> 0 then countDifference !x !y) + let alpha = logand (shift_right_logical baseColor 24) 255l in + if alpha <> Int32.zero then countDifference !x !y) else - let baseColor = IO1.readDirectPixel ~x:!x ~y:!y base in - let compColor = IO2.readDirectPixel ~x:!x ~y:!y comp in + let compColor = IO2.readRawPixelAtOffset offset comp in if baseColor <> compColor then - let delta = - ColorDelta.calculatePixelColorDelta baseColor compColor + let isIgnored = + hasIgnoreRegions && isInIgnoreRegion offset ignoreRegions in - if delta > maxDelta then - let isIgnored = isInIgnoreRegion offset ignoreRegions in - if not isIgnored then + + if not isIgnored then + let delta = + ColorDelta.calculatePixelColorDelta baseColor compColor + in + if delta > maxDelta then let isAntialiased = if not antialiasing then false else @@ -88,7 +97,7 @@ module MakeDiff (IO1 : ImageIO.ImageIO) (IO2 : ImageIO.ImageIO) = struct let diff (base : IO1.t ImageIO.img) (comp : IO2.t ImageIO.img) ~outputDiffMask ?(threshold = 0.1) ~diffPixel ?(failOnLayoutChange = true) - ?(antialiasing = false) ?(diffLines = false) ?(ignoreRegions = []) () = + ?(antialiasing = false) ?(diffLines = false) ?ignoreRegions () = if failOnLayoutChange = true && (base.width <> comp.width || base.height <> comp.height) diff --git a/src/ImageIO.ml b/src/ImageIO.ml index 38b52a33..2855b102 100644 --- a/src/ImageIO.ml +++ b/src/ImageIO.ml @@ -7,7 +7,8 @@ module type ImageIO = sig val loadImage : string -> t img val makeSameAsLayout : t img -> t img - val readDirectPixel : x:int -> y:int -> t img -> Int32.t + val readRawPixelAtOffset : int -> t img -> Int32.t [@@inline.always] + val readRawPixel : x:int -> y:int -> t img -> Int32.t [@@inline.always] val setImgColor : x:int -> y:int -> Int32.t -> t img -> unit val saveImage : t img -> string -> unit val freeImage : t img -> unit diff --git a/src/dune b/src/dune index 1573174e..6974b191 100644 --- a/src/dune +++ b/src/dune @@ -7,8 +7,8 @@ (env (dev (flags (:standard -w +42)) - (ocamlopt_flags (:standard -S))) + (ocamlopt_flags (:standard -unsafe))) (release - (ocamlopt_flags (:standard -O3 -rounds 5 -unbox-closures -inline 200 -inline-max-depth 7 -unbox-closures-factor 50)))) + (ocamlopt_flags (:standard -unsafe -O3 -rounds 5 -unboxed-types -unbox-closures -inline 200 -inline-max-depth 7 -unbox-closures-factor 50))))