ImageAnalyzer

module ImageAnalyzer

open System
open System.Drawing
open Emgu.CV
open Emgu.CV.Structure

type HistComparisonCategory  = 
    | PerfectMatch
    | CloseMatch //between 75% and 100%
    | LooseMatch //between 40% and 75%
    | MajorDifference //between 10 and 40%
    | NoRelevance //between 1% and 10%
    | NoMatch 

type HistogramMetadata = {
    Histogram       : float32 array
    Comparison      : HistComparisonCategory
}

type HistComparison = {
    Metadata            : HistogramMetadata
    ComparisonGrade     : float
}

type DetectionMetadata = {
    NumberOfFaces   : int 
    FacePositions   : Point list
}

type DetectionCategory = 
    | Detected
    | NotDetected

type DetectionResult = { 
    DetectionSuccess        : bool
    Metadata                : DetectionMetadata option
}

type FaceData = {
    Metadata        : DetectionMetadata 
    ComparisonGrade : float
}

type ImageMetadata = {
    HistogramMeta       : HistComparison
    FaceDetectionMeta   : FaceData
    OverallScore        : float 
}

let produceImageColorHistogram(srcPath: string) = 
  let img = new Image<Gray, byte>(srcPath)
  // Create and initialize histogram
  let hist = new DenseHistogram(256, new RangeF(0.0f, 255.0f));
  // Histogram Computing
  let depthMatrix = Array.create 1 img
  hist.Calculate<Byte>(depthMatrix,false,null)
  hist.GetBinValues()

let compareImageColorHistogram(local:string, dbImg: string) = 
    let localResult = produceImageColorHistogram local
    let dbResult = produceImageColorHistogram dbImg

    let dbSum = dbResult|> Array.sum |> float
    let localSum = localResult|> Array.sum |> float

    let factor = Math.Abs(1.0 - dbSum/localSum) 
    let comparison =
        match factor with 
        | perfect when perfect = 0.0 -> PerfectMatch
        | minVariance when minVariance >= 0.75 && minVariance < 1.00 ->  CloseMatch
        | someVariance when someVariance >= 0.4 && someVariance < 0.75 ->  LooseMatch
        | bigDiff when bigDiff >= 0.10 && bigDiff < 0.40 ->  MajorDifference
        | major when major >= 0.09 && major < 0.00 -> NoRelevance 
        | _ -> NoMatch

    { Histogram = dbResult; Comparison = comparison }

let retrieveComparisonGrade category = 
    match category with 
    | PerfectMatch -> 5.0 
    | CloseMatch -> 4.0
    | LooseMatch -> 3.0
    | MajorDifference -> 2.0
    | NoRelevance -> 1.0
    | NoMatch -> 0.0

let getPositions (rects: Rectangle array) = 
    let mutable locations = [] 
    for rectangle in rects do 
        locations <- locations |> List.append [rectangle.Location] 
    locations

let produceFaceMedataInImage(srcPath: string) = 
    let capture = new Capture()
    let haarCascade = new CascadeClassifier(@"haarcascade_frontalface_alt.xml")
    let img = new Image<Bgr, byte>(srcPath)
    let grayFrames = img.Convert<Gray, byte>()
    let faces = haarCascade.DetectMultiScale(grayFrames,1.0975,3, Size.Empty)
    let detectionOp = faces |> Array.length > 0
    match detectionOp with 
    | true -> 
        { DetectionSuccess = true; Metadata = Some { NumberOfFaces =  (faces |> Array.length); FacePositions = (getPositions faces) } }
    | false ->  
        { DetectionSuccess = false; Metadata = None }

let computeFaceDataWhenSimilar(fMeta: DetectionMetadata, sMeta: DetectionMetadata) = 
    let mutable sameFacePosCount = 0 
    let zipFacePositions = fMeta.FacePositions |> List.zip sMeta.FacePositions
    let areFacesAtSamePositions = 
        zipFacePositions 
        |> List.forall(fun (pos: Point*Point) -> 
            let fPos = fst pos
            let sPos = snd pos 
            let predicate = (fPos.X = sPos.X && fPos.Y = sPos.Y)
            if predicate then sameFacePosCount <- sameFacePosCount + 1
            predicate
            )
    if areFacesAtSamePositions then 5.0 
    else 
        let factor = (sameFacePosCount |> float)/(fMeta.FacePositions.Length |> float)
        2.50 + factor * 2.50

let compareFaceDetectionResults(local: string, dbImg:string) =
    let localResult = produceFaceMedataInImage local
    let dbResult = produceFaceMedataInImage dbImg
    let detectionResult = 
        match localResult.DetectionSuccess, dbResult.DetectionSuccess with
        | (true, true) -> Detected 
        | _,_ -> NotDetected

    let grade = 
        match detectionResult with 
        | Detected -> 
            let lData = localResult.Metadata.Value 
            let dData = dbResult.Metadata.Value
            if  lData.NumberOfFaces = dData.NumberOfFaces && lData.FacePositions.Length = dData.FacePositions.Length then 
                computeFaceDataWhenSimilar(lData,dData)
            elif lData.NumberOfFaces < dData.NumberOfFaces then 5.0 * ((lData.NumberOfFaces |>float)/(dData.NumberOfFaces|>float))
            else 0.0
        | NotDetected -> 0.0
    { Metadata = dbResult.Metadata.Value; ComparisonGrade = grade }
                
let compareImages(firstPath: string, secondPath: string) = 
    let histMetadata = compareImageColorHistogram(firstPath, secondPath)
    let histGrade = retrieveComparisonGrade histMetadata.Comparison
    let faceMetadata = compareFaceDetectionResults(firstPath, secondPath)
    let overallScore = histGrade + faceMetadata.ComparisonGrade
    { 
        HistogramMeta =
            {
                Metadata = histMetadata
                ComparisonGrade = histGrade 
            }
        FaceDetectionMeta = faceMetadata
        OverallScore = overallScore 
    }