Fix some approximation issues.
authorGreg Burri <greg.burri@gmail.com>
Tue, 19 Jan 2016 09:56:46 +0000 (10:56 +0100)
committerGreg Burri <greg.burri@gmail.com>
Tue, 19 Jan 2016 09:56:46 +0000 (10:56 +0100)
Parasitemia/ParasitemiaCore/Classifier.fs
Parasitemia/ParasitemiaCore/EEOver.fs
Parasitemia/ParasitemiaCore/Ellipse.fs
Parasitemia/ParasitemiaCore/Heap.fs
Parasitemia/ParasitemiaCore/MainAnalysis.fs
Parasitemia/ParasitemiaCore/MatchingEllipses.fs
Parasitemia/ParasitemiaCore/Types.fs
Parasitemia/ParasitemiaCore/Utils.fs
Parasitemia/ParasitemiaUI/GUI.fs
Parasitemia/ParasitemiaUI/Program.fs
Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml

index 0bea084..479ba59 100644 (file)
@@ -47,24 +47,30 @@ let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img:
 
         // Return 'true' if the point 'p' is owned by e.
         // The lines represents all intersections with other ellipses.
 
         // Return 'true' if the point 'p' is owned by e.
         // The lines represents all intersections with other ellipses.
-        let pixelOwnedByE (p: PointD) (e: Ellipse) (others: (Ellipse * Line) list) =
+        let pixelOwnedByE (p: PointF) (e: Ellipse) (others: (Ellipse * Line) list) =
             e.Contains p.X p.Y &&
             seq {
             e.Contains p.X p.Y &&
             seq {
-                let c = PointD(e.Cx, e.Cy)
+                let c = PointF(e.Cx, e.Cy)
+
                 for e', d1 in others do
                 for e', d1 in others do
-                    let d2 = Utils.lineFromTwoPoints c p
-                    let c' = PointD(e'.Cx, e'.Cy)
+                    let d2 = lineFromTwoPoints c p
+                    let c' = PointF(e'.Cx, e'.Cy)
                     let v = pointFromTwoLines d1 (lineFromTwoPoints c c')
                     let case1 = sign (v.X - c.X) <> sign (v.X - c'.X) || Utils.squaredDistanceTwoPoints v c > Utils.squaredDistanceTwoPoints v c'
                     if d2.Valid
                     then
                         let p' = Utils.pointFromTwoLines d1 d2
                     let v = pointFromTwoLines d1 (lineFromTwoPoints c c')
                     let case1 = sign (v.X - c.X) <> sign (v.X - c'.X) || Utils.squaredDistanceTwoPoints v c > Utils.squaredDistanceTwoPoints v c'
                     if d2.Valid
                     then
                         let p' = Utils.pointFromTwoLines d1 d2
+                        let delta, delta' =
+                            let d = c.X - p.X
+                            // To avoid rounding.
+                            if abs d < 0.001f then c.Y - p.Y, c.Y - p'.Y else d, c.X - p'.X
+
                         // Yield 'false' when the point is owned by another ellipse.
                         if case1
                         then
                         // Yield 'false' when the point is owned by another ellipse.
                         if case1
                         then
-                            yield sign (c.X - p.X) <> sign (c.X - p'.X) || Utils.squaredDistanceTwoPoints c p' > Utils.squaredDistanceTwoPoints c p
+                            yield sign delta <> sign delta' || Utils.squaredDistanceTwoPoints c p' > Utils.squaredDistanceTwoPoints c p
                         else
                         else
-                            yield sign (c.X - p.X) = sign (c.X - p'.X) && Utils.squaredDistanceTwoPoints c p' < Utils.squaredDistanceTwoPoints c p
+                            yield sign delta = sign delta' && Utils.squaredDistanceTwoPoints c p' < Utils.squaredDistanceTwoPoints c p
                     else
                         yield case1
             } |> Seq.forall id
                     else
                         yield case1
             } |> Seq.forall id
@@ -73,7 +79,7 @@ let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img:
 
         // 1) Associate touching ellipses with each ellipses and remove ellipse with more than two intersections.
         let tree = KdTree.Tree.BuildTree ellipses
 
         // 1) Associate touching ellipses with each ellipses and remove ellipse with more than two intersections.
         let tree = KdTree.Tree.BuildTree ellipses
-        let neighbors (e: EllipseFlaggedKd) : (EllipseFlaggedKd * PointD * PointD) list =
+        let neighbors (e: EllipseFlaggedKd) : (EllipseFlaggedKd * PointF * PointF) list =
             if not e.Removed
             then
                 tree.Search (searchRegion e)
             if not e.Removed
             then
                 tree.Search (searchRegion e)
@@ -86,7 +92,7 @@ let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img:
                                 otherE.Removed <- true
                                 None
                             | Some (area, px, py) when area > 0.f && px.Length = 2 ->
                                 otherE.Removed <- true
                                 None
                             | Some (area, px, py) when area > 0.f && px.Length = 2 ->
-                                Some (otherE, PointD(px.[0], py.[0]), PointD(px.[1], py.[1]))
+                                Some (otherE, PointF(px.[0], py.[0]), PointF(px.[1], py.[1]))
                             | _ ->
                                 None
                         else
                             | _ ->
                                 None
                         else
@@ -135,7 +141,7 @@ let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img:
                 let mutable area = 0
                 for y in (if minY < 0 then 0 else minY) .. (if maxY >= h then h - 1 else maxY) do
                     for x in (if minX < 0 then 0 else minX) .. (if maxX >= w then w - 1 else maxX) do
                 let mutable area = 0
                 for y in (if minY < 0 then 0 else minY) .. (if maxY >= h then h - 1 else maxY) do
                     for x in (if minX < 0 then 0 else minX) .. (if maxX >= w then w - 1 else maxX) do
-                        let p = PointD(float32 x, float32 y)
+                        let p = PointF(float32 x, float32 y)
                         if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
                         then
                             area <- area + 1
                         if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
                         then
                             area <- area + 1
@@ -161,7 +167,7 @@ let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img:
                 let elements = new Matrix<byte>(maxY - minY + 1, maxX - minX + 1)
                 for y in minY .. maxY do
                     for x in minX .. maxX do
                 let elements = new Matrix<byte>(maxY - minY + 1, maxX - minX + 1)
                 for y in minY .. maxY do
                     for x in minX .. maxX do
-                        let p = PointD(float32 x, float32 y)
+                        let p = PointF(float32 x, float32 y)
                         if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
                         then
                             elements.[y-minY, x-minX] <- 1uy
                         if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
                         then
                             elements.[y-minY, x-minX] <- 1uy
index a1358e9..7db9687 100644 (file)
@@ -2,7 +2,7 @@
 
 open System
 
 
 open System
 
-let private EPS = 1.0e-5
+let private EPS = 1.0e-7
 
 let inline private ellipse2tr (x: float) (y: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) : float =
     aa * x * x + bb * x * y + cc * y * y + dd * x + ee * y + ff
 
 let inline private ellipse2tr (x: float) (y: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) : float =
     aa * x * x + bb * x * y + cc * y * y + dd * x + ee * y + ff
@@ -301,28 +301,28 @@ let private fourintpts (xint: float[]) (yint: float[]) (a1: float) (b1: float) (
     if area5 < 0.0
     then
 #if DEBUG_LOG
     if area5 < 0.0
     then
 #if DEBUG_LOG
-        printf "\n\t\t-------------> area5 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area5 area_2
+        printf "\n\t\t-------------> area5 is negative (%f). Add: pi*A2*B2=%f <------------\n" area5 area_2
 #endif
         area5 <- area5 + area_2
 
     if area4 < 0.0
     then
 #if DEBUG_LOG
 #endif
         area5 <- area5 + area_2
 
     if area4 < 0.0
     then
 #if DEBUG_LOG
-        printf "\n\t\t-------------> area4 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area4 area_2
+        printf "\n\t\t-------------> area4 is negative (%f). Add: pi*A2*B2=%f <------------\n" area4 area_2
 #endif
         area4 <- area4 + area_2
 
     if area3 < 0.0
     then
 #if DEBUG_LOG
 #endif
         area4 <- area4 + area_2
 
     if area3 < 0.0
     then
 #if DEBUG_LOG
-        printf "\n\t\t-------------> area3 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area3 area_1
+        printf "\n\t\t-------------> area3 is negative (%f). Add: pi*A2*B2=%f <------------\n" area3 area_1
 #endif
         area3 <- area3 + area_1
 
     if area2 < 0.0
     then
 #if DEBUG_LOG
 #endif
         area3 <- area3 + area_1
 
     if area2 < 0.0
     then
 #if DEBUG_LOG
-        printf "\n\t\t-------------> area2 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area2 area_1
+        printf "\n\t\t-------------> area2 is negative (%f). Add: pi*A2*B2=%f <------------\n" area2 area_1
 #endif
         area2 <- area2 + area_1
 
 #endif
         area2 <- area2 + area_1
 
@@ -518,8 +518,8 @@ let EEOverlapArea (e1: Types.Ellipse) (e2: Types.Ellipse) : (float32 * float32[]
     then
         None
     else
     then
         None
     else
-        let phi_1 = phi_1 % Math.PI //(if phi_1 > Math.PI / 2.0 then phi_1 - Math.PI else phi_1) % Math.PI
-        let phi_2 = phi_2 % Math.PI //(if phi_2 > Math.PI / 2.0 then phi_2 - Math.PI else phi_2) % Math.PI
+        let phi_1 = phi_1 % Math.PI
+        let phi_2 = phi_2 % Math.PI
         let h2_tr, k2_tr, phi_2r =
             let cosphi = cos phi_1
             let sinphi = sin phi_1
         let h2_tr, k2_tr, phi_2r =
             let cosphi = cos phi_1
             let sinphi = sin phi_1
@@ -647,8 +647,8 @@ let EEOverlapArea (e1: Types.Ellipse) (e2: Types.Ellipse) : (float32 * float32[]
                 let x2 = -x1
 
 #if DEBUG_LOG
                 let x2 = -x1
 
 #if DEBUG_LOG
-                printf "\tx1=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x1)= %f\n" x1 ychk.[i] a1 b1 (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff)
-                printf "\tx2=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x2) %f\n" x2 ychk.[i] a1 b1 (ellipse2tr x2 ychk.[i] aa bb cc dd ee ff)
+                printf "\n\tx1=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x1)= %f\n" x1 ychk.[i] a1 b1 (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff)
+                printf "\tx2=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x2)= %f\n" x2 ychk.[i] a1 b1 (ellipse2tr x2 ychk.[i] aa bb cc dd ee ff)
 #endif
 
                 if abs (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff) < EPS
 #endif
 
                 if abs (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff) < EPS
@@ -713,8 +713,13 @@ let EEOverlapArea (e1: Types.Ellipse) (e2: Types.Ellipse) : (float32 * float32[]
                 | 3 -> threeintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
                 | 4 -> fourintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
                 | _ -> -1.0
                 | 3 -> threeintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
                 | 4 -> fourintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
                 | _ -> -1.0
-            if nintpts = 0
-            then Some (float32 area, [||], [||])
+
+            if area = -1.0
+            then
+                None
+            elif nintpts = 0
+            then
+                Some (float32 area, [||], [||])
             else
                 let xTransform : float32[] = Array.zeroCreate nintpts
                 let yTransform : float32[] = Array.zeroCreate nintpts
             else
                 let xTransform : float32[] = Array.zeroCreate nintpts
                 let yTransform : float32[] = Array.zeroCreate nintpts
index 520d29d..e65100b 100644 (file)
@@ -269,7 +269,7 @@ let find (edges: Matrix<byte>)
     let incrementWindowDivisor = 4.f
 
     // We choose a window size for which the biggest ellipse can always be fitted in.
     let incrementWindowDivisor = 4.f
 
     // We choose a window size for which the biggest ellipse can always be fitted in.
-    let windowSize = roundInt (2.f * r2 / (incrementWindowDivisor - 1.f) * incrementWindowDivisor)
+    let windowSize = roundInt (2.f * r2)
     let factorNbPick = config.Parameters.factorNbPick
 
     let increment = windowSize / (int incrementWindowDivisor)
     let factorNbPick = config.Parameters.factorNbPick
 
     let increment = windowSize / (int incrementWindowDivisor)
@@ -336,7 +336,6 @@ let find (edges: Matrix<byte>)
                         then
                             match areVectorsValid (float32 p1xf) (float32 p1yf) (float32 p2xf) (float32 p2yf) -xDirData.[p1.Y, p1.X, 0] -yDirData.[p1.Y, p1.X, 0] -xDirData.[p2.Y, p2.X, 0] -yDirData.[p2.Y, p2.X, 0] with
                             | Some (m1, m2) ->
                         then
                             match areVectorsValid (float32 p1xf) (float32 p1yf) (float32 p2xf) (float32 p2yf) -xDirData.[p1.Y, p1.X, 0] -yDirData.[p1.Y, p1.X, 0] -xDirData.[p2.Y, p2.X, 0] -yDirData.[p2.Y, p2.X, 0] with
                             | Some (m1, m2) ->
-                                //let pouet = ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf
                                 match ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf with
                                 | Some e when e.Cx > 0.f && e.Cx < w_f - 1.f && e.Cy > 0.f && e.Cy < h_f - 1.f &&
                                               e.A >= r1 - radiusTolerance && e.A <= r2 + radiusTolerance && e.B >= r1 - radiusTolerance && e.B <= r2 + radiusTolerance ->
                                 match ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf with
                                 | Some e when e.Cx > 0.f && e.Cx < w_f - 1.f && e.Cy > 0.f && e.Cy < h_f - 1.f &&
                                               e.A >= r1 - radiusTolerance && e.A <= r2 + radiusTolerance && e.B >= r1 - radiusTolerance && e.B <= r2 + radiusTolerance ->
index e4230eb..c23cdbb 100644 (file)
@@ -13,6 +13,10 @@ type private Node<'k, 'v> =
     new (k, v) = { key = k; value = v }
     override this.ToString () = sprintf "%A -> %A" this.key this.value
 
     new (k, v) = { key = k; value = v }
     override this.ToString () = sprintf "%A -> %A" this.key this.value
 
+/// <summary>
+/// An heap min or max depending of the comparer.
+/// The goal is to have a set of data and be able to get the value associated with the min (or max) key.
+/// </summary>
 type Heap<'k, 'v> (kComparer : IComparer<'k>) =
     let a = List<Node<'k, 'v>>()
 
 type Heap<'k, 'v> (kComparer : IComparer<'k>) =
     let a = List<Node<'k, 'v>>()
 
index 0faf54a..0f368d8 100644 (file)
@@ -36,7 +36,7 @@ let doAnalysis (img: Image<Bgr, byte>) (name: string) (config: Config) (reportPr
     logWithName (sprintf "Nominal erytrocyte diameter: %A" config.RBCRadiusByResolution)
 
     let initialAreaOpening = int <| config.RBCRadiusByResolution.Area * config.Parameters.ratioAreaPaleCenter * 1.2f // We do an area opening a little larger to avoid to do a second one in the case the radius found is near the initial one.
     logWithName (sprintf "Nominal erytrocyte diameter: %A" config.RBCRadiusByResolution)
 
     let initialAreaOpening = int <| config.RBCRadiusByResolution.Area * config.Parameters.ratioAreaPaleCenter * 1.2f // We do an area opening a little larger to avoid to do a second one in the case the radius found is near the initial one.
-    logTimeWithName "Area opening number one" (fun () -> ImgTools.areaOpenF filteredGreen initialAreaOpening)
+    logTimeWithName "First area opening" (fun () -> ImgTools.areaOpenF filteredGreen initialAreaOpening)
 
     report 10
 
 
     report 10
 
@@ -53,7 +53,7 @@ let doAnalysis (img: Image<Bgr, byte>) (name: string) (config: Config) (reportPr
     let secondAreaOpening = int <| config.RBCRadius.Area * config.Parameters.ratioAreaPaleCenter
     if secondAreaOpening > initialAreaOpening
     then
     let secondAreaOpening = int <| config.RBCRadius.Area * config.Parameters.ratioAreaPaleCenter
     if secondAreaOpening > initialAreaOpening
     then
-        logTimeWithName "Area opening number two" (fun () -> ImgTools.areaOpenF filteredGreen secondAreaOpening)
+        logTimeWithName "Second area opening" (fun () -> ImgTools.areaOpenF filteredGreen secondAreaOpening)
 
     let parasites, filteredGreenWhitoutStain = ParasitesMarker.find filteredGreen config
     //let parasites, filteredGreenWhitoutInfection, filteredGreenWhitoutStain = ParasitesMarker.findMa greenFloat filteredGreenFloat config
 
     let parasites, filteredGreenWhitoutStain = ParasitesMarker.find filteredGreen config
     //let parasites, filteredGreenWhitoutInfection, filteredGreenWhitoutStain = ParasitesMarker.findMa greenFloat filteredGreenFloat config
index b9b4b83..ec10d93 100644 (file)
@@ -29,7 +29,7 @@ type MatchingEllipses (radius: float32) =
     let ellipses = List<EllipseScoreFlaggedKd>()
 
     // All ellipses with a score below this are removed.
     let ellipses = List<EllipseScoreFlaggedKd>()
 
     // All ellipses with a score below this are removed.
-    let matchingScoreThreshold = 0.8f
+    let matchingScoreThreshold = 0.4f // 0.5f
 
     member this.Add (e: Ellipse) =
         ellipses.Add(EllipseScoreFlaggedKd(0.f, e))
 
     member this.Add (e: Ellipse) =
         ellipses.Add(EllipseScoreFlaggedKd(0.f, e))
@@ -59,10 +59,10 @@ type MatchingEllipses (radius: float32) =
                     then
                         let areaOther = other.Ellipse.Area
                         match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
                     then
                         let areaOther = other.Ellipse.Area
                         match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
-                        | Some (overlapArea, _, _) ->
-                            let matchingScore = (2.f * overlapArea / (areaE + areaOther)) ** 30.f
-                            if matchingScore <= 1.f // For approximation error.
-                            then
+                        | Some (overlapArea, _, _)
+                            // Because of approximation error, see https://github.com/chraibi/EEOver/issues/4
+                            when overlapArea - areaE < 1.f && overlapArea - areaOther < 1.f ->
+                                let matchingScore = (2.f * overlapArea / (areaE + areaOther)) ** 30.f
                                 other.AddMatchingScore(matchingScore)
                                 e.AddMatchingScore(matchingScore)
                         | _ -> ()
                                 other.AddMatchingScore(matchingScore)
                                 e.AddMatchingScore(matchingScore)
                         | _ -> ()
@@ -81,7 +81,7 @@ type MatchingEllipses (radius: float32) =
                         if not other.Removed && e.MatchingScore > other.MatchingScore
                         then
                             // Case where ellipses are too close.
                         if not other.Removed && e.MatchingScore > other.MatchingScore
                         then
                             // Case where ellipses are too close.
-                            if distanceTwoPoints (PointD(e.Ellipse.Cx, e.Ellipse.Cy)) (PointD(other.Ellipse.Cx, other.Ellipse.Cy)) < 0.3f * e.Ellipse.B
+                            if distanceTwoPoints (PointF(e.Ellipse.Cx, e.Ellipse.Cy)) (PointF(other.Ellipse.Cx, other.Ellipse.Cy)) < 0.3f * e.Ellipse.B
                             then
                                 other.Removed <- true
                             else
                             then
                                 other.Removed <- true
                             else
@@ -91,7 +91,6 @@ type MatchingEllipses (radius: float32) =
                                     other.Removed <- true
                                 | _ ->
                                     ()
                                     other.Removed <- true
                                 | _ ->
                                     ()
-
             ellipses
             |> List.ofSeq
             |> List.filter (fun e -> not e.Removed)
             ellipses
             |> List.ofSeq
             |> List.filter (fun e -> not e.Removed)
index ffe40b5..8a3bd4f 100644 (file)
@@ -58,7 +58,7 @@ type Line (a: float32, b: float32) =
     member this.Valid = not (Single.IsInfinity this.A)
 
 [<Struct>]
     member this.Valid = not (Single.IsInfinity this.A)
 
 [<Struct>]
-type PointD (x: float32, y: float32) =
+type PointF (x: float32, y: float32) =
     member this.X = x
     member this.Y = y
 
     member this.X = x
     member this.Y = y
 
index bf245aa..2af692d 100644 (file)
@@ -1,5 +1,7 @@
 module ParasitemiaCore.Utils
 
 module ParasitemiaCore.Utils
 
+open System
+
 open Types
 
 let inline roundInt v = v |> round |> int
 open Types
 
 let inline roundInt v = v |> round |> int
@@ -7,24 +9,24 @@ let inline roundInt v = v |> round |> int
 let inline dprintfn fmt =
     Printf.ksprintf System.Diagnostics.Debug.WriteLine fmt
 
 let inline dprintfn fmt =
     Printf.ksprintf System.Diagnostics.Debug.WriteLine fmt
 
-let inline lineFromTwoPoints (p1: PointD) (p2: PointD) : Line =
+let inline lineFromTwoPoints (p1: PointF) (p2: PointF) : Line =
     let a = (p1.Y - p2.Y) / (p1.X - p2.X)
     let b = -(p2.X * p1.Y - p1.X * p2.Y) / (p1.X - p2.X)
     Line(a, b)
 
     let a = (p1.Y - p2.Y) / (p1.X - p2.X)
     let b = -(p2.X * p1.Y - p1.X * p2.Y) / (p1.X - p2.X)
     Line(a, b)
 
-let inline pointFromTwoLines (l1: Line) (l2: Line) : PointD =
+let inline pointFromTwoLines (l1: Line) (l2: Line) : PointF =
     let x = -(l1.B - l2.B) / (l1.A - l2.A)
     let y = -(l2.A * l1.B - l1.A * l2.B) / (l1.A - l2.A)
     let x = -(l1.B - l2.B) / (l1.A - l2.A)
     let y = -(l2.A * l1.B - l1.A * l2.B) / (l1.A - l2.A)
-    PointD(x, y)
+    PointF(x, y)
 
 
-let inline linePassThroughSegment (l: Line) (p1: PointD) (p2: PointD) : bool =
+let inline linePassThroughSegment (l: Line) (p1: PointF) (p2: PointF) : bool =
     let p = pointFromTwoLines l (lineFromTwoPoints p1 p2)
     sign (p.X - p1.X) <> sign (p.X - p2.X)
 
     let p = pointFromTwoLines l (lineFromTwoPoints p1 p2)
     sign (p.X - p1.X) <> sign (p.X - p2.X)
 
-let inline squaredDistanceTwoPoints (p1: PointD) (p2: PointD) =
+let inline squaredDistanceTwoPoints (p1: PointF) (p2: PointF) =
     (p1.X - p2.X) ** 2.f + (p1.Y - p2.Y) ** 2.f
 
     (p1.X - p2.X) ** 2.f + (p1.Y - p2.Y) ** 2.f
 
-let inline distanceTwoPoints (p1: PointD) (p2: PointD) =
+let inline distanceTwoPoints (p1: PointF) (p2: PointF) =
     squaredDistanceTwoPoints p1 p2 |> sqrt
 
 let countCells (cells: Cell list) : int * int =
     squaredDistanceTwoPoints p1 p2 |> sqrt
 
 let countCells (cells: Cell list) : int * int =
index efe01c3..d30cb66 100644 (file)
@@ -403,26 +403,24 @@ let run (defaultConfig: Config) (fileToOpen: string option) =
             state.FilePath <- previousFilePath
             MessageBox.Show(sprintf "The document cannot be loaded from '%s'" state.FilePath, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
 
             state.FilePath <- previousFilePath
             MessageBox.Show(sprintf "The document cannot be loaded from '%s'" state.FilePath, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
 
-    txtPatient.TextChanged.AddHandler(fun obj args -> state.PatientID <- txtPatient.Text)
-
-    menuExit.Click.AddHandler(fun obj args ->
-        askSaveCurrent ()
-        mainWindow.Root.Close())
-
-    menuSaveFile.Click.AddHandler(fun obj args -> saveCurrentDocument ())
-    menuSaveAsFile.Click.AddHandler(fun obj args -> saveCurrentDocumentAsNewFile ())
-
-    menuLoadFile.Click.AddHandler(fun obj args ->
-        // TODO: if current state not saved and not empty, ask to save it.
+    let askLoadFile () =
         let dialog = OpenFileDialog(Filter = PiaZ.filter)
         let res = dialog.ShowDialog()
         if res.HasValue && res.Value
         let dialog = OpenFileDialog(Filter = PiaZ.filter)
         let res = dialog.ShowDialog()
         if res.HasValue && res.Value
-        then loadFile dialog.FileName)
+        then loadFile dialog.FileName
 
 
-    menuNewFile.Click.AddHandler(fun obj args ->
+    let newFile () =
         askSaveCurrent ()
         state.Reset()
         askSaveCurrent ()
         state.Reset()
-        updateGUI())
+        updateGUI()
+
+    txtPatient.TextChanged.AddHandler(fun obj args -> state.PatientID <- txtPatient.Text)
+
+    menuExit.Click.AddHandler(fun obj args -> mainWindow.Root.Close())
+    menuSaveFile.Click.AddHandler(fun obj args -> saveCurrentDocument ())
+    menuSaveAsFile.Click.AddHandler(fun obj args -> saveCurrentDocumentAsNewFile ())
+    menuLoadFile.Click.AddHandler(fun obj args -> askLoadFile ())
+    menuNewFile.Click.AddHandler(fun obj args -> newFile ())
 
     menuAddSourceImage.Click.AddHandler(fun obj args ->
         let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
 
     menuAddSourceImage.Click.AddHandler(fun obj args ->
         let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
@@ -461,6 +459,8 @@ let run (defaultConfig: Config) (fileToOpen: string option) =
 
     menuAbout.Click.AddHandler(fun obj args -> About.showWindow mainWindow.Root)
 
 
     menuAbout.Click.AddHandler(fun obj args -> About.showWindow mainWindow.Root)
 
+    mainWindow.Root.Closing.AddHandler(fun obj args -> askSaveCurrent ())
+
     // Zoom on the current image.
     let adjustCurrentImageBorders (deltaX: float) (deltaY: float) =
         borderCurrentImage.BorderThickness <-
     // Zoom on the current image.
     let adjustCurrentImageBorders (deltaX: float) (deltaY: float) =
         borderCurrentImage.BorderThickness <-
@@ -544,11 +544,30 @@ let run (defaultConfig: Config) (fileToOpen: string option) =
             args.Handled <- true)
 
     // Shortcuts.
             args.Handled <- true)
 
     // Shortcuts.
+    // Save.
     mainWindow.Root.InputBindings.Add(
         Input.KeyBinding(
             FSharp.ViewModule.FunCommand((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
             Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control))) |> ignore
 
     mainWindow.Root.InputBindings.Add(
         Input.KeyBinding(
             FSharp.ViewModule.FunCommand((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
             Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control))) |> ignore
 
+    // Save as.
+    mainWindow.Root.InputBindings.Add(
+        Input.KeyBinding(
+            FSharp.ViewModule.FunCommand((fun obj -> saveCurrentDocumentAsNewFile ()), (fun obj -> true)),
+            Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift))) |> ignore
+
+    // Open.
+    mainWindow.Root.InputBindings.Add(
+        Input.KeyBinding(
+            FSharp.ViewModule.FunCommand((fun obj -> askLoadFile ()), (fun obj -> true)),
+            Input.KeyGesture(Input.Key.O, Input.ModifierKeys.Control))) |> ignore
+
+    // New file.
+    mainWindow.Root.InputBindings.Add(
+        Input.KeyBinding(
+            FSharp.ViewModule.FunCommand((fun obj -> newFile ()), (fun obj -> true)),
+            Input.KeyGesture(Input.Key.N, Input.ModifierKeys.Control))) |> ignore
+
     // Viewport preview.
     scrollViewCurrentImage.ScrollChanged.AddHandler(fun obj args -> updateViewportPreview ())
 
     // Viewport preview.
     scrollViewCurrentImage.ScrollChanged.AddHandler(fun obj args -> updateViewportPreview ())
 
index bbf20b3..74f0d35 100644 (file)
@@ -29,11 +29,11 @@ let parseArgs (args: string[]) : Arguments =
     let runningMode =
         match Array.tryFindIndex ((=) "--folder") args, output with
         | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
     let runningMode =
         match Array.tryFindIndex ((=) "--folder") args, output with
         | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
-            CmdLine ((Dir args.[i+1]), args.[i_output + 1])
+            CmdLine ((Dir args.[i + 1]), args.[i_output + 1])
         | _ ->
             match Array.tryFindIndex ((=) "--file") args, output with
             | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
         | _ ->
             match Array.tryFindIndex ((=) "--file") args, output with
             | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
-                CmdLine ((File args.[i+1]), args.[i_output + 1])
+                CmdLine ((File args.[i + 1]), args.[i_output + 1])
             |_ ->
                 Window (if args.Length > 0 && not (args.[0].StartsWith("--")) then Some args.[0] else None)
 
             |_ ->
                 Window (if args.Length > 0 && not (args.[0].StartsWith("--")) then Some args.[0] else None)
 
@@ -59,7 +59,8 @@ let main args =
                     Directory.CreateDirectory output |> ignore
 
                     use logFile = new StreamWriter(new FileStream(Path.Combine(output, "log.txt"), FileMode.Append, FileAccess.Write))
                     Directory.CreateDirectory output |> ignore
 
                     use logFile = new StreamWriter(new FileStream(Path.Combine(output, "log.txt"), FileMode.Append, FileAccess.Write))
-                    Log.AddListener({ new IListener with member this.NewEntry mess severity = logFile.WriteLine(mess) })
+                    let listener = { new IListener with member this.NewEntry severity mess = logFile.WriteLine(mess) }
+                    Log.AddListener(listener)
 
                     Log.User (sprintf "=== New run : %A %A ===" DateTime.Now  (if debug then "[DEBUG]" else "[RELEASE]"))
 
 
                     Log.User (sprintf "=== New run : %A %A ===" DateTime.Now  (if debug then "[DEBUG]" else "[RELEASE]"))
 
@@ -79,6 +80,8 @@ let main args =
                             let config = images |> List.pick (fun (id', config', _) -> if id' = id then Some config' else None)
                             let total, infected = countCells cells
                             fprintf resultFile "File: %s %d %d %.2f (diameter: %A)\n" id total infected (100. * (float infected) / (float total)) config.RBCRadius))
                             let config = images |> List.pick (fun (id', config', _) -> if id' = id then Some config' else None)
                             let total, infected = countCells cells
                             fprintf resultFile "File: %s %d %d %.2f (diameter: %A)\n" id total infected (100. * (float infected) / (float total)) config.RBCRadius))
+
+                    Log.RmListener(listener)
                     0
 
                 | Window fileToOpen ->
                     0
 
                 | Window fileToOpen ->
index 931b9b8..6037bc1 100644 (file)
@@ -7,10 +7,10 @@
    <DockPanel x:Name="dockPanelMain" LastChildFill="True">
       <Menu DockPanel.Dock="Top">
          <MenuItem Header="_File">
    <DockPanel x:Name="dockPanelMain" LastChildFill="True">
       <Menu DockPanel.Dock="Top">
          <MenuItem Header="_File">
-            <MenuItem x:Name="menuNew" Header="_New"  />
-            <MenuItem x:Name="menuOpen" Header="_Open" />
-            <MenuItem x:Name="menuSave" Header="_Save" />
-            <MenuItem x:Name="menuSaveAs" Header="_Save As..." />
+            <MenuItem x:Name="menuNew" Header="_New" InputGestureText="Ctrl+N" />
+            <MenuItem x:Name="menuOpen" Header="_Open" InputGestureText="Ctrl+O" />
+            <MenuItem x:Name="menuSave" Header="_Save" InputGestureText="Ctrl+S" />
+            <MenuItem x:Name="menuSaveAs" Header="Save _As..." InputGestureText="Ctrl+Shift+S" />
             <Separator />
             <MenuItem x:Name="menuExit" Header="_Exit" />
          </MenuItem>
             <Separator />
             <MenuItem x:Name="menuExit" Header="_Exit" />
          </MenuItem>