// 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 {
- let c = PointD(e.Cx, e.Cy)
+ let c = PointF(e.Cx, e.Cy)
+
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 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 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 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
// 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)
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
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
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
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
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
- 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
- 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
- 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
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 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
| 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
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)
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 ->
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>>()
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
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 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))
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)
| _ -> ()
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
other.Removed <- true
| _ ->
()
-
ellipses
|> List.ofSeq
|> List.filter (fun e -> not e.Removed)
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
module ParasitemiaCore.Utils
+open System
+
open Types
let inline roundInt v = v |> round |> int
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 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)
- 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 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
-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 =
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
- then loadFile dialog.FileName)
+ then loadFile dialog.FileName
- menuNewFile.Click.AddHandler(fun obj args ->
+ let newFile () =
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)
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 <-
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
+ // 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 ())
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 ->
- 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)
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]"))
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 ->
<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>
projects / master-thesis.git / commitdiff