let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name
- let mutable stream: StreamWriter = null
+ let mutable stream : StreamWriter = null
- let mutable logDir: string = null
- let mutable absoluteDir: string = null
+ let mutable logDir : string = null
+ let mutable absoluteDir : string = null
let mutable nbEntries = 0L
static let instance = new Log()
- let setLogDirectory (dir: string) =
+ let setLogDirectory (dir : string) =
lock monitor (fun () ->
logDir <- dir
absoluteDir <- Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), logDir)
- if stream <> null
- then
+ if stream <> null then
stream.Close()
stream <- null
try
- if not <| Directory.Exists(absoluteDir)
- then
+ if not <| Directory.Exists(absoluteDir) then
Directory.CreateDirectory(absoluteDir) |> ignore
with
| _ as ex -> Console.Error.WriteLine("Unable to create the log directory: {0}", absoluteDir))
let openLogFile () =
try
- if stream = null || (nbEntries % (int64 nbEntriesCheckSize) = 0L) && stream.BaseStream.Length > maxSizeFile
- then
- if stream <> null
- then
+ if stream = null || (nbEntries % (int64 nbEntriesCheckSize) = 0L) && stream.BaseStream.Length > maxSizeFile then
+ if stream <> null then
stream.Close()
let mutable n = 1
for existingFile in Directory.GetFiles(absoluteDir) do
let current_n = ref 0
- if Int32.TryParse(existingFile.Remove(existingFile.LastIndexOf('.')), current_n) && !current_n > n
- then
+ if Int32.TryParse(existingFile.Remove(existingFile.LastIndexOf('.')), current_n) && !current_n > n then
n <- !current_n
let mutable filename = Path.Combine(absoluteDir, String.Format(filenameFormat, n))
try
- if (FileInfo(filename).Length > maxSizeFile)
- then
+ if (FileInfo(filename).Length > maxSizeFile) then
filename <- Path.Combine(absoluteDir, String.Format(filenameFormat, n + 1))
with
| :? FileNotFoundException -> () // The file may not exist.
interface IDisposable with
member this.Dispose () =
- if stream <> null
- then
+ if stream <> null then
stream.Dispose()
- member private this.Write (message: string, severity: Severity) =
+ member private this.Write (message : string, severity : Severity) =
lock monitor (fun () ->
nbEntries <- nbEntries + 1L
openLogFile ()
- if stream <> null
- then
+ if stream <> null then
let mutable moduleNameCaller = moduleName
match StackTrace().GetFrames() |> Array.tryPick (fun frame -> let name = frame.GetMethod().Module.Name
if name <> moduleName then Some name else None) with
| :? IOException as ex -> Console.Error.WriteLine("Unable to write to the log file: {0}", ex))
- member private this.AddListener (listener: IListener) =
+ member private this.AddListener (listener : IListener) =
lock monitor (fun () ->
- if not <| listeners.Contains(listener)
- then
+ if not <| listeners.Contains(listener) then
listeners.Add(listener))
- member private this.RmListener (listener: IListener) =
+ member private this.RmListener (listener : IListener) =
lock monitor (fun () ->
listeners.Remove(listener) |> ignore)
- static member AddListener (listener: IListener) = instance.AddListener(listener)
- static member RmListener (listener: IListener) = instance.RmListener(listener)
+ static member AddListener (listener : IListener) = instance.AddListener(listener)
+ static member RmListener (listener : IListener) = instance.RmListener(listener)
- static member LogWithTime (message: string, severity: Severity, f: unit -> 'a option, [<ParamArray>] args: Object[]) : 'a option =
+ static member LogWithTime (message : string, severity : Severity, f : unit -> 'a option, [<ParamArray>] args: Object[]) : 'a option =
let sw = Stopwatch()
sw.Start()
let res = f ()
sw.Stop()
- if res.IsSome
- then
+ if res.IsSome then
instance.Write(String.Format(message, args) + sprintf " (time: %d ms)" sw.ElapsedMilliseconds, severity)
res
- static member Debug (message: string, [<ParamArray>] args: Object[]) =
+ static member Debug (message : string, [<ParamArray>] args : Object[]) =
#if DEBUG
instance.Write(String.Format(message, args), Severity.DEBUG)
#else
()
#endif
- static member User (message: string, [<ParamArray>] args: Object[]) =
+ static member User (message : string, [<ParamArray>] args : Object[]) =
instance.Write(String.Format(message, args), Severity.USER)
- static member Warning (message: string, [<ParamArray>] args: Object[]) =
+ static member Warning (message : string, [<ParamArray>] args : Object[]) =
instance.Write(String.Format(message, args), Severity.WARNING)
- static member Error (message: string, [<ParamArray>] args: Object[]) =
+ static member Error (message : string, [<ParamArray>] args : Object[]) =
instance.Write(String.Format(message, args), Severity.ERROR)
- static member Fatal (message: string, [<ParamArray>] args: Object[]) =
+ static member Fatal (message : string, [<ParamArray>] args : Object[]) =
instance.Write(String.Format(message, args), Severity.FATAL)
<OutputType>Library</OutputType>
<RootNamespace>Logger</RootNamespace>
<AssemblyName>Logger</AssemblyName>
- <TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
- <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
+ <TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
+ <TargetFSharpCoreVersion>4.4.1.0</TargetFSharpCoreVersion>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<Name>Logger</Name>
<TargetFrameworkProfile />
/// The first call returning 'false' will cancel the analysis.
/// The 'int' parameter correspond to the progression from 0 to 100</param>
/// <returns>A list of detected cells or nothing if the process has been cancelled</returns>
-let doAnalysis (img: Image<Bgr, byte>) (name: string) (config: Config) (reportProgress: (int -> bool) option) : Cell list option =
+let doAnalysis (img : Image<Bgr, byte>) (name : string) (config : Config) (reportProgress : (int -> bool) option) : Cell list option =
// To report the progress of this function from 0 to 100.
// Return 'None' if the process must be aborted.
- let reportWithVal (percent: int) (value: 'a) : 'a option =
+ let reportWithVal (percent : int) (value : 'a) : 'a option =
match reportProgress with
- | Some f ->
- if f percent
- then Some value
- else None
+ | Some f -> if f percent then Some value else None
| _ -> Some value
- let report (percent: int) : unit option =
+ let report (percent : int) : unit option =
reportWithVal percent ()
- let inline buildLogWithName (text: string) = sprintf "№ %s: %s" name text
+ let inline buildLogWithName (text : string) = sprintf "№ %s: %s" name text
let logWithName mess = Log.User(buildLogWithName mess)
- let inline logTimeWithName (text: string) (f: unit -> 'a option) : 'a option = Log.LogWithTime((buildLogWithName text), Severity.USER, f)
+ let inline logTimeWithName (text : string) (f : unit -> 'a option) : 'a option = Log.LogWithTime((buildLogWithName text), Severity.USER, f)
// Monadic construction to be able to abort the progress when running.
maybe {
use img_parasites = img_float.[2] // Red.
use img_parasites_filtered = gaussianFilter img_parasites config.LPFStandardDeviationParasite
- logWithName (sprintf "Nominal erythrocyte diameter: %A" config.RBCRadiusByResolution)
+ logWithName (sprintf "Nominal erythrocyte diameter: %O" config.RBCRadiusByResolution)
let initialAreaOpening = int <| config.RBCRadiusByResolution.Area * config.Parameters.ratioAreaPaleCenter * 1.1f // 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.
do! logTimeWithName "First area opening" (fun () -> areaOpenF img_RBC_filtered initialAreaOpening; report 10)
//let! radius = logTimeWithName "Granulometry (morpho)" (fun() -> reportWithVal 10 (Granulometry.findRadiusByClosing img_RBC_filtered range 1. true |> float32))
config.SetRBCRadius <| radius
- logWithName (sprintf "Found erythrocyte diameter: %A" config.RBCRadius)
+ logWithName (sprintf "Found erythrocyte diameter: %O" config.RBCRadius)
do! report 20
do!
let secondAreaOpening = int <| config.RBCRadius.Area * config.Parameters.ratioAreaPaleCenter
- if secondAreaOpening > initialAreaOpening
- then
+ if secondAreaOpening > initialAreaOpening then
logTimeWithName "Second area opening" (fun () -> areaOpenF img_RBC_filtered secondAreaOpening; report 30)
else
report 30
IO.saveImg img_float.[0] (buildFileName " - source - blue.png")
| _ -> ()
- return cells }
+ return cells
+ }
/// <summary>
/// Do multiple analyses on the same time. The number of concurrent process depends if the number of the core.
/// The first call returning 'false' will cancel the analysis.
/// The 'int' parameter correspond to the progression from 0 to 100</param>
/// <returns>'None' if the process has been cancelled or the list of result as (name * cells), 'name' corresponds to the given name<returns>
-let doMultipleAnalysis (imgs: (string * Config * Image<Bgr, byte>) list) (reportProgress: (int -> bool) option) : (string * Cell list) list option =
- let report (percent: int) : bool =
+let doMultipleAnalysis (imgs : (string * Config * Image<Bgr, byte>) list) (reportProgress : (int -> bool) option) : (string * Cell list) list option =
+ let report (percent : int) : bool =
match reportProgress with
| Some f -> f percent
| _ -> true
let progressPerAnalysis = System.Collections.Concurrent.ConcurrentDictionary<string, int>()
let nbImgs = List.length imgs
- let reportProgressImg (id: string) (progress: int) =
+ let reportProgressImg (id : string) (progress : int) =
progressPerAnalysis.AddOrUpdate(id, progress, (fun _ _ -> progress)) |> ignore
report (progressPerAnalysis.Values.Sum() / nbImgs)
with
| ex ->
Log.Error("Analysis {0} failed: {1}", id, ex)
- None)
+ None
+ )
|> PSeq.withDegreeOfParallelism n
|> PSeq.toList
// If one of the analyses has been aborted we return 'None'.
- if List.length results <> List.length imgs
- then None
- else Some results
+ if List.length results <> List.length imgs then
+ None
+ else
+ Some results
// You can specify all the values or you can default the Build and Revision Numbers
// by using the '*' as shown below:
// [<assembly: AssemblyVersion("1.0.*")>]
-[<assembly: AssemblyVersion("1.0.0.7")>]
-[<assembly: AssemblyFileVersion("1.0.0.7")>]
+[<assembly: AssemblyVersion("1.0.0.8")>]
+[<assembly: AssemblyFileVersion("1.0.0.8")>]
do
()
\ No newline at end of file
type CellState = RBC = 1 | Removed = 2 | Peculiar = 3
-type private EllipseFlaggedKd (e: Ellipse) =
+type private EllipseFlaggedKd (e : Ellipse) =
inherit Ellipse (e.Cx, e.Cy, e.A, e.B, e.Alpha)
member val State = CellState.RBC with get, set
member this.X = this.Cx
member this.Y = this.Cy
-let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (width: int) (height: int) (config: Config.Config) : Cell list =
- if ellipses.IsEmpty
- then
+let findCells (ellipses : Ellipse list) (parasites : ParasitesMarker.Result) (width : int) (height : int) (config : Config.Config) : Cell list =
+ if ellipses.IsEmpty then
[]
else
// This is the minimum window size to check if other ellipses touch 'e'.
- let searchRegion (e: Ellipse) = { KdTree.minX = e.Cx - (e.A + config.RBCRadius.Max)
- KdTree.maxX = e.Cx + (e.A + config.RBCRadius.Max)
- KdTree.minY = e.Cy - (e.A + config.RBCRadius.Max)
- KdTree.maxY = e.Cy + (e.A + config.RBCRadius.Max) }
+ let searchRegion (e : Ellipse) =
+ {
+ KdTree.minX = e.Cx - (e.A + config.RBCRadius.Max)
+ KdTree.maxX = e.Cx + (e.A + config.RBCRadius.Max)
+ KdTree.minY = e.Cy - (e.A + config.RBCRadius.Max)
+ KdTree.maxY = e.Cy + (e.A + config.RBCRadius.Max)
+ }
// The minimum window to contain a given ellipse.
- let ellipseWindow (e: Ellipse) =
+ let ellipseWindow (e : Ellipse) =
let cx, cy = roundInt e.Cx, roundInt e.Cy
let a = int (e.A + 0.5f)
cx - a, cy - a, cx + a, cy + a
// Return 'true' if the point 'p' is owned by e.
// The lines represents all intersections with other ellipses.
- let pixelOwnedByE (p: PointF) (e: EllipseFlaggedKd) (neighbors: (EllipseFlaggedKd * PointF * PointF) list) =
+ let pixelOwnedByE (p : PointF) (e : EllipseFlaggedKd) (neighbors : (EllipseFlaggedKd * PointF * PointF) list) =
e.Contains p.X p.Y &&
seq {
let c = PointF(e.Cx, e.Cy)
- for e', d1 in neighbors
- |> List.choose (fun (otherE, p1, p2) ->
- if otherE.State = CellState.Removed
- then None
- else Some (otherE, Utils.lineFromTwoPoints p1 p2)) do
- if e'.State = e.State // Peculiar vs peculiar or RBC vs RBC.
- then
+ for e', d1 in
+ (neighbors
+ |> List.choose (
+ fun (otherE, p1, p2) ->
+ if otherE.State = CellState.Removed then
+ None
+ else
+ Some (otherE, Utils.lineFromTwoPoints p1 p2)
+ )) do
+ if e'.State = e.State then // Peculiar vs peculiar or RBC vs RBC.
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 not (Single.IsInfinity d2.A)
- then
+ if not (Single.IsInfinity d2.A) then
let p' = Utils.pointFromTwoLines d1 d2
let delta, delta' =
let dx1, dx2 = (c.X - p.X), (c.X - p'.X)
if abs dx1 < 0.01f || abs dx2 < 0.01f then c.Y - p.Y, c.Y - p'.Y else dx1, dx2
// Yield 'false' when the point is owned by another ellipse.
- if case1
- then
+ if case1 then
yield sign delta <> sign delta' || Utils.squaredDistanceTwoPoints c p' > Utils.squaredDistanceTwoPoints c p
else
yield sign delta = sign delta' && Utils.squaredDistanceTwoPoints c p' < Utils.squaredDistanceTwoPoints c p
else
yield case1
- elif e.State = CellState.Peculiar // A peculiar always win against a RBC.
- then
+ elif e.State = CellState.Peculiar then // A peculiar always win against a RBC.
yield true
else
yield not <| e'.Contains p.X p.Y
// 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 * PointF * PointF) list =
- if e.State <> CellState.Removed
- then
+ let neighbors (e : EllipseFlaggedKd) : (EllipseFlaggedKd * PointF * PointF) list =
+ if e.State <> CellState.Removed then
tree.Search (searchRegion e)
// We only keep the ellipses touching 'e'.
|> List.choose (fun otherE ->
- if e <> otherE
- then
+ if e <> otherE then
match EEOver.EEOverlapArea e otherE with
| Some (_, px, _) when px.Length > 2 ->
otherE.State <- CellState.Removed
| _ ->
None
else
- None)
+ None
+ )
else
[]
yield float imgData.[y, x, 0] })
for e in ellipses do
- if not e.Removed
- then
+ if not e.Removed then
let shrinkedE = e.Scale 0.9f
let minX, minY, maxX, maxY = ellipseWindow shrinkedE
let stdDeviation = MathNet.Numerics.Statistics.Statistics.StandardDeviation (seq {
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
- if shrinkedE.Contains (float32 x) (float32 y)
- then
+ if shrinkedE.Contains (float32 x) (float32 y) then
yield float imgData.[y, x, 0] })
if stdDeviation > globalStdDeviation * config.Parameters.standardDeviationMaxRatio then
// 4) Remove ellipses with little area.
let minArea = config.RBCRadius.MinArea
for e, neighbors in ellipsesWithNeigbors do
- if e.State <> CellState.Removed
- then
+ if e.State <> CellState.Removed then
let minX, minY, maxX, maxY = ellipseWindow e
let mutable area = 0
for y = (if minY < 0 then 0 else minY) to (if maxY >= height then height - 1 else maxY) do
for x = (if minX < 0 then 0 else minX) to (if maxX >= width then width - 1 else maxX) do
let p = PointF(float32 x, float32 y)
- if pixelOwnedByE p e neighbors
- then
+ if pixelOwnedByE p e neighbors then
area <- area + 1
- if area < int minArea
- then
+ if area < int minArea then
e.State <- CellState.Removed
// 5) Define non-rbc (peculiar) cells.
let darkStainData = parasites.darkStain.Data
ellipsesWithNeigbors
|> List.choose (fun (e, neighbors) ->
- if e.State = CellState.Removed
- then
+ if e.State = CellState.Removed then
None
else
let mutable darkStainPixels = 0
for y = minY to maxY do
for x = minX to maxX do
let p = PointF(float32 x, float32 y)
- if pixelOwnedByE p e neighbors
- then
+ if pixelOwnedByE p e neighbors then
nbElement <- nbElement + 1
- if darkStainData.[y, x, 0] > 0uy
- then
+ if darkStainData.[y, x, 0] > 0uy then
darkStainPixels <- darkStainPixels + 1
if float darkStainPixels > config.Parameters.maxDarkStainRatio * (float nbElement) then Some e else None)
let darkStainData = parasites.darkStain.Data
ellipsesWithNeigbors
- |> List.choose (fun (e, neighbors) ->
- if e.State = CellState.Removed
- then
- None
- else
- let minX, minY, maxX, maxY = ellipseWindow e
-
- let nucleusPixels = List<Point>()
- let parasitePixels = List<Point>()
-
- let mutable nbElement = 0
-
- let elements = new Matrix<byte>(maxY - minY + 1, maxX - minX + 1)
- for y = minY to maxY do
- for x = minX to maxX do
- let p = PointF(float32 x, float32 y)
- if pixelOwnedByE p e neighbors
- then
- elements.[y - minY, x - minX] <- 1uy
- nbElement <- nbElement + 1
-
- if nucleusData.[y, x, 0] > 0uy
- then
- nucleusPixels.Add(Point(x, y))
-
- if parasiteData.[y, x, 0] > 0uy
- then
- parasitePixels.Add(Point(x, y))
-
- let parasiteArea =
- if nucleusPixels.Count > 0
- then
- seq {
- for parasitePixel in parasitePixels do
- if nucleusPixels.Exists(fun p -> pown (p.X - parasitePixel.X) 2 + pown (p.Y - parasitePixel.Y) 2 <= diameterParasiteSquared)
- then yield 1 } |> Seq.sum
- else
- 0
+ |> List.choose (
+ fun (e, neighbors) ->
+ if e.State = CellState.Removed then
+ None
+ else
+ let minX, minY, maxX, maxY = ellipseWindow e
+
+ let nucleusPixels = List<Point>()
+ let parasitePixels = List<Point>()
+
+ let mutable nbElement = 0
+
+ let elements = new Matrix<byte>(maxY - minY + 1, maxX - minX + 1)
+ for y = minY to maxY do
+ for x = minX to maxX do
+ let p = PointF(float32 x, float32 y)
+ if pixelOwnedByE p e neighbors then
+ elements.[y - minY, x - minX] <- 1uy
+ nbElement <- nbElement + 1
+
+ if nucleusData.[y, x, 0] > 0uy then
+ nucleusPixels.Add(Point(x, y))
+
+ if parasiteData.[y, x, 0] > 0uy then
+ parasitePixels.Add(Point(x, y))
+
+ let parasiteArea =
+ if nucleusPixels.Count > 0 then
+ seq {
+ for parasitePixel in parasitePixels do
+ if nucleusPixels.Exists(fun p -> pown (p.X - parasitePixel.X) 2 + pown (p.Y - parasitePixel.Y) 2 <= diameterParasiteSquared) then
+ yield 1
+ } |> Seq.sum
+ else
+ 0
- let cellClass =
- if e.State = CellState.Peculiar
- then
- Peculiar
+ let cellClass =
+ if e.State = CellState.Peculiar then
+ Peculiar
- elif nucleusPixels.Count > 0 && parasiteArea >= minimumParasiteArea
- then
- let infectionToRemove = Morpho.connectedComponents parasites.parasite nucleusPixels
- for p in infectionToRemove do
- nucleusData.[p.Y, p.X, 0] <- 0uy
- InfectedRBC
+ elif nucleusPixels.Count > 0 && parasiteArea >= minimumParasiteArea then
+ let infectionToRemove = Morpho.connectedComponents parasites.parasite nucleusPixels
+ for p in infectionToRemove do
+ nucleusData.[p.Y, p.X, 0] <- 0uy
+ InfectedRBC
- else
- HealthyRBC
-
- Some { cellClass = cellClass
- center = Point(roundInt e.Cx, roundInt e.Cy)
- nucleusArea = if cellClass = InfectedRBC then nucleusPixels.Count else 0
- parasiteArea = parasiteArea
- elements = elements })
+ else
+ HealthyRBC
+
+ Some
+ {
+ cellClass = cellClass
+ center = Point(roundInt e.Cx, roundInt e.Cy)
+ nucleusArea = if cellClass = InfectedRBC then nucleusPixels.Count else 0
+ parasiteArea = parasiteArea
+ elements = elements
+ }
+ )
| DebugOff
| DebugOn of string // Output directory.
-type Parameters = {
- rbcDiameter: float<μm>
- resolution: float<ppi>
+type Parameters =
+ {
+ rbcDiameter : float<μm>
+ resolution : float<ppi>
- ratioAreaPaleCenter: float32 // The area of the second opening is 'ratioSecondAreaOpen' * mean RBC area. It's applied only if greater than 'initialAreaOpen'.
+ ratioAreaPaleCenter : float32 // The area of the second opening is 'ratioSecondAreaOpen' * mean RBC area. It's applied only if greater than 'initialAreaOpen'.
- granulometryRange: float32 // The radius will be seeked from radius - granulometryRange * radius to radius + granulometryRange * radius.
+ granulometryRange : float32 // The radius will be seeked from radius - granulometryRange * radius to radius + granulometryRange * radius.
- minRbcRadius: float32 // Factor of the mean RBC radius.
- maxRbcRadius: float32 // Factor of the mean RBC radius.
+ minRbcRadius : float32 // Factor of the mean RBC radius.
+ maxRbcRadius : float32 // Factor of the mean RBC radius.
- LPFStandardDeviationParasite: float<μm> // Sigma parameter of the gaussian to remove the high frequency noise.
- LPFStandardDeviationRBC: float<μm>
+ LPFStandardDeviationParasite : float<μm> // Sigma parameter of the gaussian to remove the high frequency noise.
+ LPFStandardDeviationRBC : float<μm>
- // Ellipse.
- nbPickElementsMin: int
- factorNbValidPick: float // The number of computed ellipse per edge pixel.
- factorNbMaxPick: float
+ // Ellipse.
+ nbPickElementsMin : int
+ factorNbValidPick : float // The number of computed ellipse per edge pixel.
+ factorNbMaxPick : float
- // Parasites detection.
- darkStainLevel: float // Lower -> more sensitive. Careful about illumination on the borders.
- maxDarkStainRatio: float // When a cell must own less than this ratio to be a RBC.
+ // Parasites detection.
+ darkStainLevel : float // Lower -> more sensitive. Careful about illumination on the borders.
+ maxDarkStainRatio : float // When a cell must own less than this ratio to be a RBC.
- parasiteRadiusRatio: float32 // The ratio of the parasite radius of the RBC radius.
- minimumParasiteAreaRatio: float32 // Factor of a RBC area. 0.5 means the half of RBC area.
+ parasiteRadiusRatio : float32 // The ratio of the parasite radius of the RBC radius.
+ minimumParasiteAreaRatio : float32 // Factor of a RBC area. 0.5 means the half of RBC area.
- cytoplasmSizeRatio: float32
- cytoplasmSensitivity: float // between 0 (the least sensitive) and 1 (the most sensitive).
+ cytoplasmSizeRatio : float32
+ cytoplasmSensitivity : float // between 0 (the least sensitive) and 1 (the most sensitive).
- nucleusAreaRatio: float32 // Factor of a RBC area. 0.5 means the half of RBC area.
- infectionSensitivity: float // between 0 (the least sensitive) and 1 (the most sensitive).
+ nucleusAreaRatio : float32 // Factor of a RBC area. 0.5 means the half of RBC area.
+ infectionSensitivity : float // between 0 (the least sensitive) and 1 (the most sensitive).
- // [<Obsolete>] standardDeviationMaxRatio: float // The standard deviation of the pixel values of a cell can't be greater than standardDeviationMaxRatio * global standard deviation
- minimumCellAreaFactor: float32 } // Factor of the mean RBC area. A cell with an area below this will be rejected.
+ // [<Obsolete>] standardDeviationMaxRatio: float // The standard deviation of the pixel values of a cell can't be greater than standardDeviationMaxRatio * global standard deviation
+ minimumCellAreaFactor : float32 // Factor of the mean RBC area. A cell with an area below this will be rejected.
+ }
-let defaultParameters = {
- rbcDiameter = 7.5<μm>
- resolution = 230.e3<ppi> // 230.e3<ppi> Correspond to 50X.
+let defaultParameters =
+ {
+ rbcDiameter = 7.5<μm>
+ resolution = 230.e3<ppi> // 230.e3<ppi> Correspond to 50X.
- ratioAreaPaleCenter = 2.f / 5.f // The ratio between an RBC area and the area of the its pale center.
+ ratioAreaPaleCenter = 2.f / 5.f // The ratio between an RBC area and the area of the its pale center.
- granulometryRange = 0.5f
+ granulometryRange = 0.5f
- minRbcRadius = -0.23f
- maxRbcRadius = 0.23f
+ minRbcRadius = -0.23f
+ maxRbcRadius = 0.23f
- LPFStandardDeviationParasite = 0.15<μm>
- LPFStandardDeviationRBC = 0.22<μm>
+ LPFStandardDeviationParasite = 0.15<μm>
+ LPFStandardDeviationRBC = 0.22<μm>
- nbPickElementsMin = 10
- factorNbValidPick = 0.06 //1.0
- factorNbMaxPick = 4.
+ nbPickElementsMin = 10
+ factorNbValidPick = 0.06 //1.0
+ factorNbMaxPick = 4.
- darkStainLevel = 1.
- maxDarkStainRatio = 0.1 // 10 %
+ darkStainLevel = 1.
+ maxDarkStainRatio = 0.1 // 10 %
- parasiteRadiusRatio = 0.5f // 50 %
- minimumParasiteAreaRatio = 0.02f // 2 %
+ parasiteRadiusRatio = 0.5f // 50 %
+ minimumParasiteAreaRatio = 0.02f // 2 %
- cytoplasmSizeRatio = 1.f / 5.f
- cytoplasmSensitivity = 0.96
+ cytoplasmSizeRatio = 1.f / 5.f
+ cytoplasmSensitivity = 0.96
- nucleusAreaRatio = 0.01f // 1.0 %
- infectionSensitivity = 0.92
+ nucleusAreaRatio = 0.01f // 1.0 %
+ infectionSensitivity = 0.92
- // standardDeviationMaxRatio = 0.6 // Obsolete.
- minimumCellAreaFactor = 0.4f }
+ // standardDeviationMaxRatio = 0.6 // Obsolete.
+ minimumCellAreaFactor = 0.4f
+ }
-type RBCRadius (radius: float32, parameters: Parameters) =
+type RBCRadius (radius : float32, parameters : Parameters) =
member this.Pixel = radius
member this.μm : float<μm> =
1.<px> * (float radius) / parameters.resolution |> inchToμm
override this.ToString() =
sprintf "%d px (%.1f μm)" (Utils.roundInt <| 2.f * radius) (2. * this.μm)
-type Config (param: Parameters) =
- let RBCadiusInPixels (rbcDiameter: float<μm>) (resolution: float<ppi>) : float32 =
- let rbcRadiusInch: float<inch> = (μmToInch rbcDiameter) / 2.
- let rbcRadiusPx: float<px> = resolution * rbcRadiusInch
+type Config (param : Parameters) =
+ let RBCadiusInPixels (rbcDiameter : float<μm>) (resolution : float<ppi>) : float32 =
+ let rbcRadiusInch : float<inch> = (μmToInch rbcDiameter) / 2.
+ let rbcRadiusPx : float<px> = resolution * rbcRadiusInch
float32 rbcRadiusPx
- let mutable parameters: Parameters = param
+ let mutable parameters : Parameters = param
let mutable rbcRadiusByResolution = RBCRadius(RBCadiusInPixels parameters.rbcDiameter parameters.resolution, parameters)
let mutable rbcRadius = RBCRadius(0.f, parameters)
member val Debug = DebugOff with get, set
member this.LPFStandardDeviationParasite =
- let stdDeviation: float<px> = (μmToInch parameters.LPFStandardDeviationParasite) * parameters.resolution
+ let stdDeviation : float<px> = (μmToInch parameters.LPFStandardDeviationParasite) * parameters.resolution
float stdDeviation
member this.LPFStandardDeviationRBC =
- let stdDeviation: float<px> = (μmToInch parameters.LPFStandardDeviationRBC) * parameters.resolution
+ let stdDeviation : float<px> = (μmToInch parameters.LPFStandardDeviationRBC) * parameters.resolution
float stdDeviation
member this.RBCRadiusByResolution = rbcRadiusByResolution
member this.RBCRadius = rbcRadius
- member this.SetRBCRadius (radiusPixel: float32) =
+ member this.SetRBCRadius (radiusPixel : float32) =
rbcRadius <- RBCRadius(radiusPixel, parameters)
member this.Copy () =
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 =
+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 private nointpts (a1: float) (b1: float) (a2: float) (b2: float) (h1: float) (k1: float) (h2: float) (k2: float) (phi_1: float) (phi_2: float) (h2_tr: float) (k2_tr: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) =
+let private nointpts (a1 : float) (b1 : float) (a2 : float) (b2 : float) (h1 : float) (k1 : float) (h2 : float) (k2 : float) (phi_1 : float) (phi_2 : float) (h2_tr : float) (k2_tr : float) (aa : float) (bb : float) (cc : float) (dd : float) (ee : float) (ff : float) =
let a1b1 = a1 * b1
let a2b2 = a2 * b2
let area_1 = Math.PI * a1b1
let area_2 = Math.PI * a2b2
let relsize = a1b1 - a2b2
- if relsize > 0.0
- then
- if (h2_tr * h2_tr) / (a1 * a1) + (k2_tr * k2_tr) / (b1 * b1) < 1.0
- then area_2
- else 0.0
+ if relsize > 0.0 then
+ if (h2_tr * h2_tr) / (a1 * a1) + (k2_tr * k2_tr) / (b1 * b1) < 1.0 then
+ area_2
+ else
+ 0.0
- elif relsize < 0.0
- then
- if ff < 0.0
- then area_1
- else 0.0
+ elif relsize < 0.0 then
+ if ff < 0.0 then
+ area_1
+ else
+ 0.0
else
- if abs (h1 - h2) < EPS && abs (k1 - k2) < EPS && abs (area_1 - area_2) < EPS
- then area_1
- else 0.0
+ if abs (h1 - h2) < EPS && abs (k1 - k2) < EPS && abs (area_1 - area_2) < EPS then
+ area_1
+ else
+ 0.0
type private PointType = TANGENT_POINT | INTERSECTION_POINT
-let private istanpt (x: float) (y: float) (a1: float) (b1: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) : PointType =
+let private istanpt (x : float) (y : float) (a1 : float) (b1 : float) (aa : float) (bb : float) (cc : float) (dd : float) (ee : float) (ff : float) : PointType =
let x =
- if abs x > a1
- then
+ if abs x > a1 then
if x < 0.0 then -a1 else a1
- else x
+ else
+ x
let theta =
- if y < 0.0
- then 2.0 * Math.PI - acos (x / a1)
- else acos (x / a1)
+ if y < 0.0 then
+ 2.0 * Math.PI - acos (x / a1)
+ else
+ acos (x / a1)
let eps_radian = 0.1
printf "test2=%f\n" test2
#endif
- if test1 * test2 > 0.0
- then TANGENT_POINT
- else INTERSECTION_POINT
+ if test1 * test2 > 0.0 then
+ TANGENT_POINT
+ else
+ INTERSECTION_POINT
-let private twointpts (x: float[]) (y: float[]) (a1: float) (b1: float) (phi_1: float) (a2: float) (b2: float) (h2_tr: float) (k2_tr: float) (phi_2: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) =
- if abs x.[0] > a1
- then x.[0] <- if x.[0] < 0.0 then -a1 else a1
+let private twointpts (x : float[]) (y : float[]) (a1 : float) (b1 : float) (phi_1 : float) (a2 : float) (b2 : float) (h2_tr : float) (k2_tr : float) (phi_2 : float) (aa : float) (bb : float) (cc : float) (dd : float) (ee : float) (ff : float) =
+ if abs x.[0] > a1 then
+ x.[0] <- if x.[0] < 0.0 then -a1 else a1
let mutable theta1 =
- if y.[0] < 0.0
- then 2.0 * Math.PI - acos (x.[0] / a1)
- else acos (x.[0] / a1)
+ if y.[0] < 0.0 then
+ 2.0 * Math.PI - acos (x.[0] / a1)
+ else
+ acos (x.[0] / a1)
- if abs x.[1] > a1
- then x.[1] <- if x.[1] < 0.0 then -a1 else a1
+ if abs x.[1] > a1 then
+ x.[1] <- if x.[1] < 0.0 then -a1 else a1
let mutable theta2 =
- if y.[1] < 0.0
- then 2.0 * Math.PI - acos (x.[1] / a1)
- else acos (x.[1] / a1)
+ if y.[1] < 0.0 then
+ 2.0 * Math.PI - acos (x.[1] / a1)
+ else
+ acos (x.[1] / a1)
- if theta1 > theta2
- then
+ if theta1 > theta2 then
let tmp = theta1
theta1 <- theta2
theta2 <- tmp
let xmid = a1 * cos ((theta1 + theta2) / 2.0)
let ymid = b1 * sin ((theta1 + theta2) / 2.0)
- if ellipse2tr xmid ymid aa bb cc dd ee ff > 0.0
- then
+ if ellipse2tr xmid ymid aa bb cc dd ee ff > 0.0 then
let tmp = theta1
theta1 <- theta2
theta2 <- tmp
- if theta1 > theta2
- then
+ if theta1 > theta2 then
theta1 <- theta1 - 2.0 * Math.PI
let trsign = if (theta2 - theta1) > Math.PI then 1.0 else -1.0
let mutable area1 = 0.5 * (a1 * b1 * (theta2 - theta1) + trsign * abs (x.[0] * y.[1] - x.[1] * y.[0]))
- if area1 < 0.0
- then
+ if area1 < 0.0 then
#if DEBUG_LOG
printf "TWO area1=%f\n" area1
#endif
let mutable x2_tr = (x.[1] - h2_tr) * cosphi + (y.[1] - k2_tr) * -sinphi
let mutable y2_tr = (x.[1] - h2_tr) * sinphi + (y.[1] - k2_tr) * cosphi
- if abs x1_tr > a2
- then
+ if abs x1_tr > a2 then
x1_tr <- if x1_tr < 0.0 then -a2 else a2
- if y1_tr < 0.0
- then
+ if y1_tr < 0.0 then
theta1 <- 2.0 * Math.PI - acos (x1_tr / a2)
else
theta1 <- acos (x1_tr / a2)
- if abs x2_tr > a2
- then
+ if abs x2_tr > a2 then
x2_tr <- if x2_tr < 0.0 then -a2 else a2
- if y2_tr < 0.0
- then
+ if y2_tr < 0.0 then
theta2 <- 2.0 * Math.PI - acos (x2_tr / a2)
else
theta2 <- acos (x2_tr / a2)
- if theta1 > theta2
- then
+ if theta1 > theta2 then
let tmp = theta1
theta1 <- theta2
theta2 <- tmp
let xmid_rt = xmid * cosphi + ymid * -sinphi + h2_tr
let ymid_rt = xmid * sinphi + ymid * cosphi + k2_tr
- if (xmid_rt * xmid_rt) / (a1 * a1) + (ymid_rt * ymid_rt) / (b1 * b1) > 1.0
- then
+ if (xmid_rt * xmid_rt) / (a1 * a1) + (ymid_rt * ymid_rt) / (b1 * b1) > 1.0 then
let tmp = theta1
theta1 <- theta2
theta2 <- tmp
- if theta1 > theta2
- then
+ if theta1 > theta2 then
theta1 <- theta1 - 2.0 * Math.PI
let trsign = if theta2 - theta1 > Math.PI then 1.0 else -1.0
let mutable area2 = 0.5 * (a2 * b2 * (theta2 - theta1) + trsign * abs (x1_tr * y2_tr - x2_tr * y1_tr))
- if area2 < 0.0
- then
+ if area2 < 0.0 then
#if DEBUG_LOG
printf "TWO area2=%f\n" area2
#endif
area1 + area2
-let private threeintpts (xint: float[]) (yint: float[]) (a1: float) (b1: float) (phi_1: float) (a2: float) (b2: float) (h2_tr: float) (k2_tr: float) (phi_2: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) : float =
+let private threeintpts (xint : float[]) (yint : float[]) (a1 : float) (b1 : float) (phi_1 : float) (a2 : float) (b2 : float) (h2_tr : float) (k2_tr : float) (phi_2 : float) (aa : float) (bb : float) (cc : float) (dd : float) (ee : float) (ff : float) : float =
let mutable tanpts = 0
let mutable tanindex = 0
for i = 0 to 2 do
- if istanpt xint.[i] yint.[i] a1 b2 aa bb cc dd ee ff = TANGENT_POINT
- then
+ if istanpt xint.[i] yint.[i] a1 b2 aa bb cc dd ee ff = TANGENT_POINT then
tanpts <- tanpts + 1
tanindex <- i
#if DEBUG_LOG
printf "tanindex=%d\n" tanindex
#endif
- if tanpts <> 1
- then
+ if tanpts <> 1 then
-1.0
else
match tanindex with
()
twointpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
-let private fourintpts (xint: float[]) (yint: float[]) (a1: float) (b1: float) (phi_1: float) (a2: float) (b2: float) (h2_tr: float) (k2_tr: float) (phi_2: float) (aa: float) (bb: float) (cc: float) (dd: float) (ee: float) (ff: float) : float =
+let private fourintpts (xint : float[]) (yint : float[]) (a1 : float) (b1 : float) (phi_1 : float) (a2 : float) (b2 : float) (h2_tr : float) (k2_tr : float) (phi_2 : float) (aa : float) (bb : float) (cc : float) (dd : float) (ee : float) (ff : float) : float =
let a1b1 = a1 * b1
let a2b2 = a2 * b2
let area_1 = Math.PI * a1b1
let theta = Array.zeroCreate 4
for i = 0 to 3 do
- if abs xint.[i] > a1
- then
+ if abs xint.[i] > a1 then
xint.[i] <- if xint.[i] < 0.0 then -a1 else a1
theta.[i] <- if yint.[i] < 0.0 then 2.0 * Math.PI - acos (xint.[i] / a1) else acos (xint.[i] / a1)
let mutable k = j - 1
let mutable k2 = 0
while k >= 0 do
- if theta.[k] <= tmp0
- then
+ if theta.[k] <= tmp0 then
k2 <- k + 1
k <- -1
else
xint_tr.[i] <- (xint.[i] - h2_tr) * cosphi + (yint.[i] - k2_tr) * -sinphi
yint_tr.[i] <- (xint.[i] - h2_tr) * sinphi + (yint.[i] - k2_tr) * cosphi
- if abs xint_tr.[i] > a2
- then
+ if abs xint_tr.[i] > a2 then
xint_tr.[i] <- if xint_tr.[i] < 0.0 then -a2 else a2
theta_tr.[i] <- if yint_tr.[i] < 0.0 then 2.0 * Math.PI - acos (xint_tr.[i] / a2) else acos (xint_tr.[i] / a2)
let mutable area2, area3, area4, area5 = 0.0, 0.0, 0.0, 0.0
- if ellipse2tr xmid ymid aa bb cc dd ee ff < 0.0
- then
+ if ellipse2tr xmid ymid aa bb cc dd ee ff < 0.0 then
area2 <- 0.5 * (a1b1 * (theta.[1] - theta.[0]) - abs (xint.[0] * yint.[1] - xint.[1] * yint.[0]))
area3 <- 0.5 * (a1b1 * (theta.[3] - theta.[2]) - abs (xint.[2] * yint.[3] - xint.[3] * yint.[2]))
area4 <- 0.5 * (a2b2 * (theta_tr.[2] - theta_tr.[1]) - abs (xint_tr.[1] * yint_tr.[2] - xint_tr.[2] * yint_tr.[1]))
- if theta_tr.[3] > theta_tr.[0]
- then
+ if theta_tr.[3] > theta_tr.[0] then
area5 <- 0.5 * (a2b2 * (theta_tr.[0] - (theta_tr.[3] - 2.0 * Math.PI)) - abs (xint_tr.[3] * yint_tr.[0] - xint_tr.[0] * yint_tr.[3]))
else
area5 <- 0.5 * (a2b2 * (theta_tr.[0] - theta_tr.[3]) - abs (xint_tr.[3] * yint_tr.[0] - xint_tr.[0] * yint_tr.[3]))
area4 <- 0.5 * (a2b2 * (theta_tr.[1] - theta_tr.[0]) - abs (xint_tr.[0] * yint_tr.[1] - xint_tr.[1] * yint_tr.[0]))
area5 <- 0.5 * (a2b2 * (theta_tr.[3] - theta_tr.[2]) - abs (xint_tr.[2] * yint_tr.[3] - xint_tr.[3] * yint_tr.[2]))
- if area5 < 0.0
- then
+ if area5 < 0.0 then
#if DEBUG_LOG
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 area4 < 0.0 then
#if DEBUG_LOG
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 area3 < 0.0 then
#if DEBUG_LOG
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 area2 < 0.0 then
#if DEBUG_LOG
printf "\n\t\t-------------> area2 is negative (%f). Add: pi*A2*B2=%f <------------\n" area2 area_1
#endif
area1 + area2 + area3 + area4 + area5
-let private quadroots (p: float[]) (r: float[,]) =
+let private quadroots (p : float[]) (r : float[,]) =
let mutable b = -p.[1] / (2.0 * p.[0])
let c = p.[2] / p.[0]
let mutable d = b * b - c
- if d >= 0.0
- then
- if b > 0.0
- then
+ if d >= 0.0 then
+ if b > 0.0 then
b <- sqrt d + b
r.[1, 2] <- b
else
r.[1, 1] <- b
r.[1, 2] <- b
-let private cubicroots (p: float[]) (r: float[,]) =
+let private cubicroots (p : float[]) (r : float[,]) =
if p.[0] <> 1.0 then
for k = 1 to 3 do
p.[k] <- p.[k] / p.[0]
let mutable c = t * t * t
let mutable d = b * b - c
- if d >= 0.0
- then
- d <- ((sqrt d) + (abs b)) ** (1.0 / 3.0)
- if d <> 0.0
- then
- if b > 0.0
- then b <- -d
- else b <- d
+ if d >= 0.0 then
+ d <- (sqrt d + abs b) ** (1.0 / 3.0)
+ if d <> 0.0 then
+ if b > 0.0 then
+ b <- -d
+ else
+ b <- d
c <- t / b
d <- sqrt(0.75) * (b - c)
r.[2, 2] <- d
b <- b + c
c <- -0.5 * b - s
r.[1, 2] <- c
- if b > 0.0 && s <= 0.0 || b < 0.0 && s > 0.0
- then
+ if b > 0.0 && s <= 0.0 || b < 0.0 && s > 0.0 then
r.[1, 1] <- c
r.[2, 1] <- -d
r.[1, 3] <- b - s
r.[1, 3] <- c
r.[2, 3] <- -d
else
- if b = 0.0
- then d <- (atan 1.0) / 1.5
- else d <- atan ((sqrt -d) / (abs b)) / 3.0
+ if b = 0.0 then
+ d <- (atan 1.0) / 1.5
+ else
+ d <- atan ((sqrt -d) / (abs b)) / 3.0
- if b < 0.0
- then b <- 2.0 * (sqrt t)
- else b <- -2.0 * (sqrt t)
+ if b < 0.0 then
+ b <- 2.0 * (sqrt t)
+ else
+ b <- -2.0 * (sqrt t)
c <- (cos d) * b
t <- -(sqrt 0.75) * (sin d) * b - 0.5 * c
c <- c - s
t <- t - s
- if abs c > abs t
- then
+ if abs c > abs t then
r.[1, 3] <- c
else
r.[1, 3] <- t
t <- c
- if abs d > abs t
- then
+ if abs d > abs t then
r.[1, 2] <- d
else
r.[1, 2] <- t
for k = 1 to 3 do
r.[2, k] <- 0.0
-let private biquadroots (p: float[]) (r: float[,]) =
- if p.[0] <> 1.0
- then
+let private biquadroots (p : float[]) (r : float[,]) =
+ if p.[0] <> 1.0 then
for k = 1 to 4 do
p.[k] <- p.[k] / p.[0]
p.[0] <- 1.0
let mutable quadExecuted = false
let inline quad () =
- if not quadExecuted
- then
+ if not quadExecuted then
p.[2] <- c / b
quadroots p r
for k = 1 to 2 do
p.[1] <- 0.5 * a
p.[2] <- (p.[1] * p.[1] - c) * 0.25
p.[3] <- b * b / -64.0
- if p.[3] < 0.0
- then
+ if p.[3] < 0.0 then
cubicroots p r
let mutable k = 1
while k < 4 do
- if r.[2, k] = 0.0 && r.[1, k] > 0.0
- then
+ if r.[2, k] = 0.0 && r.[1, k] > 0.0 then
d <- r.[1, k] * 4.0
a <- a + d
- if a >= 0.0 && b >= 0.0
- then
+ if a >= 0.0 && b >= 0.0 then
p.[1] <- sqrt d
- elif a <= 0.0 && b <= 0.0
- then
+ elif a <= 0.0 && b <= 0.0 then
p.[1] <- sqrt d
else
p.[1] <- -(sqrt d)
k <- 4
k <- k + 1
- if not quadExecuted && p.[2] < 0.0
- then
+ if not quadExecuted && p.[2] < 0.0 then
b <- sqrt c
d <- b + b - a
p.[1] <- 0.0
- if d > 0.0
- then
+ if d > 0.0 then
p.[1] <- sqrt d
- elif not quadExecuted
- then
- if p.[1] > 0.0
- then
+ elif not quadExecuted then
+ if p.[1] > 0.0 then
b <- (sqrt p.[2]) * 2.0 + p.[1]
else
b <- -(sqrt p.[2]) * 2.0 + p.[1]
- if b <> 0.0
- then
+ if b <> 0.0 then
p.[1] <- 0.0
else
for k = 1 to 4 do
/// <summary>
/// Return a tuple (area, x intersections, y intersections).
/// </summary>
-let EEOverlapArea (e1: Types.Ellipse) (e2: Types.Ellipse) : (float32 * float32[] * float32[]) option =
+let EEOverlapArea (e1 : Types.Ellipse) (e2 : Types.Ellipse) : (float32 * float32[] * float32[]) option =
let h1, k1, a1, b1, phi_1 = float e1.Cx, float e1.Cy, float e1.A, float e1.B, float e1.Alpha
let h2, k2, a2, b2, phi_2 = float e2.Cx, float e2.Cy, float e2.A, float e2.B, float e2.Alpha
- if a1 <= EPS || b1 <= EPS || a2 <= EPS || b2 <= EPS
- then
+ if a1 <= EPS || b1 <= EPS || a2 <= EPS || b2 <= EPS then
None
else
let phi_1 = phi_1 % Math.PI
let r = Array2D.zeroCreate<float> 3 5
let nroots =
- if abs cy.[4] > EPS
- then
+ if abs cy.[4] > EPS then
for i = 0 to 3 do
py.[4-i] <- cy.[i] / cy.[4]
py.[0] <- 1.0
biquadroots py r
4
- elif abs cy.[3] > EPS
- then
+ elif abs cy.[3] > EPS then
for i = 0 to 2 do
py.[3 - i] <- cy.[i] / cy.[3]
py.[0] <- 1.0
cubicroots py r
3
- elif abs cy.[2] > EPS
- then
+ elif abs cy.[2] > EPS then
for i = 0 to 1 do
py.[2-i] <- cy.[i] / cy.[2]
py.[0] <- 1.0
quadroots py r
2
- elif abs cy.[1] > EPS
- then
+ elif abs cy.[1] > EPS then
r.[1, 1] <- -cy.[0] / cy.[1]
r.[2, 1] <- 0.0
1
let ychk = Array.init nroots (fun _ -> Double.MaxValue)
let mutable nychk = 0
for i = 1 to nroots do
- if abs r.[2, i] < EPS
- then
+ if abs r.[2, i] < EPS then
ychk.[nychk] <- r.[1, i] * b1
nychk <- nychk + 1
#if DEBUG_LOG
printf "------------->i=%d (nychk=%d)\n" i nychk
#endif
- if not (i < nychk - 1 && abs (ychk.[i] - ychk.[i+1]) < EPS / 2.0)
- then
+ if not (i < nychk - 1 && abs (ychk.[i] - ychk.[i+1]) < EPS / 2.0) then
#if DEBUG_LOG
printf "check intersecting points. nintps is %d" nintpts
#endif
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
- then
+ if abs (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff) < EPS then
nintpts <- nintpts + 1
#if DEBUG_LOG
printf "first if x1. acc nintps=%d\n" nintpts
#endif
- if nintpts > 4
- then
+ if nintpts > 4 then
returnValue <- -1.0
else
xint.[nintpts-1] <- x1
printf "nintpts=%d, xint=%f, x2=%f, i=%d, yint=%f\n" nintpts x1 x2 i ychk.[i]
#endif
- if returnValue <> -1.0 && abs (ellipse2tr x2 ychk.[i] aa bb cc dd ee ff) < EPS && abs (x2 - x1) > EPS
- then
+ if returnValue <> -1.0 && abs (ellipse2tr x2 ychk.[i] aa bb cc dd ee ff) < EPS && abs (x2 - x1) > EPS then
nintpts <- nintpts + 1
#if DEBUG_LOG
printf "first if x2. nintps=%d, Dx=%f (eps2=%f) \n" nintpts (abs (x2 - x1)) EPS
#endif
- if nintpts > 4
- then
+ if nintpts > 4 then
returnValue <- -1.0
else
xint.[nintpts-1] <- x2
#endif
i <- i + 1
- if returnValue = -1.0
- then
+ if returnValue = -1.0 then
None
else
let area =
| 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 area = -1.0
- then
+ if area = -1.0 then
None
- elif nintpts = 0
- then
+ elif nintpts = 0 then
Some (float32 area, [||], [||])
else
let xTransform : float32[] = Array.zeroCreate nintpts
let yTransform : float32[] = Array.zeroCreate nintpts
- for i in 0 .. (nintpts - 1) do
+ for i = 0 to (nintpts - 1) do
xTransform.[i] <- float32 <| cos phi_1 * xint.[i] - sin phi_1 * yint.[i] + h1
yTransform.[i] <- float32 <| sin phi_1 * xint.[i] + cos phi_1 * yint.[i] + k1
Some (float32 area, xTransform, yTransform)
\ No newline at end of file
/// 'Ellipse.A' is always equal or greater than Ellipse.B.
/// 'Ellipse.Alpha' is between 0 and Pi.
/// </summary>
-let ellipse (p1x: float) (p1y: float) (m1: float) (p2x: float) (p2y: float) (m2: float) (p3x: float) (p3y: float) : Types.Ellipse option =
+let ellipse (p1x : float) (p1y : float) (m1 : float) (p2x : float) (p2y : float) (m2 : float) (p3x : float) (p3y : float) : Types.Ellipse option =
let p0 = pointFromTwoLines (Types.Line(float32 m1, float32 (p1y - m1 * p1x))) (Types.Line(float32 m2, float32(p2y - m2 * p2x)))
let p0x, p0y = float p0.X, float p0.Y
- let s = matrix [[ 1.; 0.; 0. ]
- [ 0.; 0.; -0.5 ]
- [ 0.; -0.5; 0. ]]
+ let s =
+ matrix
+ [
+ [ 1.; 0.; 0. ]
+ [ 0.; 0.; -0.5 ]
+ [ 0.; -0.5; 0. ]
+ ]
let v0 = matrix [[ 1.; p0x; p0y ]]
let v1 = matrix [[ 1.; p1x; p1y ]]
let cy = d / a
let at = c * f - e ** 2. + (e * d - b * f) * cx + (b * e - c * d) * cy
- if at = 0.
- then
+ if at = 0. then
None
else
let q = (-1. / at) * (matrix [[ a * f - d ** 2.0; b * d - a * e ]; [ b * d - a * e; a * c - b ** 2.0 ]])
let lambda = eigenValues.[1].Real
let mu = eigenValues.[0].Real
- if lambda <= 0. || mu <= 0.
- then
+ if lambda <= 0. || mu <= 0. then
None
else
let r1, r2 = 1. / (sqrt lambda), 1. / (sqrt mu)
Some (Types.Ellipse(float32 cx, float32 cy, float32 majorAxis, float32 minorAxis, float32 phi'))
-let inline private vectorRotation (px: float32) (py: float32) (vx: float32) (vy: float32) (p0x: float32) (p0y: float32) : float32 =
- if py > p0y
- then
+let inline private vectorRotation (px : float32) (py : float32) (vx : float32) (vy : float32) (p0x : float32) (p0y : float32) : float32 =
+ if py > p0y then
if vx > 0.f then -1.f else 1.f
- elif py < p0y
- then
+ elif py < p0y then
if vx < 0.f then -1.f else 1.f
- elif px > p0x
- then
+ elif px > p0x then
if vy < 0.f then -1.f else 1.f
else // p1x < px
if vy > 0.f then -1.f else 1.f
-let private areVectorsValid (p1x: float32) (p1y: float32) (p2x: float32) (p2y: float32) (v1x: float32) (v1y: float32) (v2x: float32) (v2y: float32) : (float32 * float32) option =
+let private areVectorsValid (p1x : float32) (p1y : float32) (p2x : float32) (p2y : float32) (v1x : float32) (v1y : float32) (v2x : float32) (v2y : float32) : (float32 * float32) option =
let m1 = -v1x / v1y
let m2 = -v2x / v2y
let rot1 = vectorRotation p1x p1y v1x v1y p0x p0y
let rot2 = vectorRotation p2x p2y v2x v2y p0x p0y
- if rot1 = rot2
- then
+ if rot1 = rot2 then
None
else
let alpha1 =
let diff = rot1 * alpha1 + rot2 * alpha2
- if diff > PI || (diff < 0.f && diff > -PI)
- then
+ if diff > PI || (diff < 0.f && diff > -PI) then
Some (m1, m2)
else
None
/// <summary>
/// Build a set of ellipses as a 'MatchingEllipses' object by finding ellipses with the given edges and gradient.
/// </summary>
-let find (edges: Matrix<byte>)
- (xGradient: Matrix<float32>)
- (yGradient: Matrix<float32>)
- (config: Config) : MatchingEllipses =
+let find (edges : Matrix<byte>)
+ (xGradient : Matrix<float32>)
+ (yGradient : Matrix<float32>)
+ (config : Config) : MatchingEllipses =
let r1, r2 = config.RBCRadius.Min, config.RBCRadius.Max
let incrementWindowDivisor = 4.f
// Remove old elements.
let indexFirstElement = currentElements.FindIndex(fun p -> p.X >= window_j_begin)
- if indexFirstElement > 0
- then currentElements.RemoveRange(0, indexFirstElement)
+ if indexFirstElement > 0 then
+ currentElements.RemoveRange(0, indexFirstElement)
// Add the new elements.
let newElemsBegin_j = window_j + windowSize - increment
let newElemsEnd_j = window_j + windowSize - 1
for j = (if newElemsBegin_j < 0 then 0 else newElemsBegin_j) to (if newElemsEnd_j >= w then w - 1 else newElemsEnd_j) do
for i = window_i_begin to window_i_end do
- if edgesData.[i, j] = 1uy
- then currentElements.Add(Point(j, i))
+ if edgesData.[i, j] = 1uy then
+ currentElements.Add(Point(j, i))
- if currentElements.Count >= nbPickElementsMin
- then
+ if currentElements.Count >= nbPickElementsMin then
let mutable nbOfPicks = (float currentElements.Count) * factorNbMaxPick |> int
let mutable nbOfValidPicks = (float currentElements.Count) * factorNbValidPick |> int
while nbOfPicks > 0 && nbOfValidPicks > 0 do
let p1 = currentElements.[rng.Next(currentElements.Count)]
let p2 = currentElements.[rng.Next(currentElements.Count)]
let p3 = currentElements.[rng.Next(currentElements.Count)]
- if p1 <> p2 && p1 <> p3 && p2 <> p3
- then
+ if p1 <> p2 && p1 <> p3 && p2 <> p3 then
nbOfPicks <- nbOfPicks - 1
let p1yf, p1xf = float p1.Y, float p1.X
let p2yf, p2xf = float p2.Y, float p2.X
/// <param name="img"></param>
/// <param name="range">Minimum radius * maximum radius</param>
/// <param name="scale">le 1.0, to speed up the process.</param>
-let findRadiusByClosing (img: Image<Gray, 'TDepth>) (range: int * int) (scale: float) (useOctagon: bool) : int =
+let findRadiusByClosing (img : Image<Gray, 'TDepth>) (range : int * int) (scale : float) (useOctagon : bool) : int =
use scaledImg = if scale = 1. then img else img.Resize(scale, CvEnum.Inter.Area)
let r1, r2 = range
let intensityImg = scaledImg.GetSum().Intensity
// 's' must be odd.
- let octagon (s: int) : Matrix<byte> =
+ let octagon (s : int) : Matrix<byte> =
if s % 2 = 0 then failwith "s must be odd"
let m = new Matrix<byte>(Array2D.create s s 1uy)
let r = (float s) / (Math.Sqrt 2. + 2.) |> roundInt
for i = 0 to r - 1 do
for j = 0 to r - 1 do
- if i + j < r
- then
+ if i + j < r then
m.[i, j] <- 0uy
m.[s - i - 1, j] <- 0uy
m.[i, s - j - 1] <- 0uy
let mutable previous_n = Double.NaN
for r = r1' to r2' do
- let se = if useOctagon
- then (octagon (2 * r - 1)).Mat // It doesn't speed up the process.
- else CvInvoke.GetStructuringElement(CvEnum.ElementShape.Ellipse, Size(2 * r, 2 * r), Point(-1, -1))
+ let se =
+ if useOctagon then
+ (octagon (2 * r - 1)).Mat // It doesn't speed up the process.
+ else
+ CvInvoke.GetStructuringElement(CvEnum.ElementShape.Ellipse, Size(2 * r, 2 * r), Point(-1, -1))
use closed = scaledImg.MorphologyEx(CvEnum.MorphOp.Close, se, Point(-1, -1), 1, CvEnum.BorderType.Replicate, MCvScalar(0.0))
let n = closed.GetSum().Intensity
- if not (Double.IsNaN previous_n)
- then
+ if not (Double.IsNaN previous_n) then
patternSpectrum.[r - r1' - 1] <- abs (n - previous_n)
previous_n <- n
/// <summary>
/// Granulometry by area closing on the image 'img' by testing the circle area into the given radius range.
/// </summary>
-let findRadiusByAreaClosing (img: Image<Gray, float32>) (radiusRange: int * int) : int =
+let findRadiusByAreaClosing (img : Image<Gray, float32>) (radiusRange : int * int) : int =
let r1, r2 = radiusRange
- if r1 > r2
- then failwithf "'radiusRange' invalid : %A" radiusRange
+ if r1 > r2 then
+ failwithf "'radiusRange' invalid : %O" radiusRange
use imgCopy = img.Copy()
let mutable max_r = r1
Morpho.areaCloseFWithFun imgCopy [ for r in r1 .. r2 -> Math.PI * float r ** 2. |> roundInt, r ] (fun r diff ->
- if r <> r1 && diff > maxDiff
- then
+ if r <> r1 && diff > maxDiff then
maxDiff <- diff
max_r <- r - 1)
max_r
open System.Collections.Generic
-let inline private parent (i: int) : int = (i - 1) / 2
-let inline private left (i: int) : int = 2 * (i + 1) - 1
-let inline private right (i: int) : int = 2 * (i + 1)
+let inline private parent (i : int) : int = (i - 1) / 2
+let inline private left (i : int) : int = 2 * (i + 1) - 1
+let inline private right (i : int) : int = 2 * (i + 1)
[<Struct>]
type private Node<'k, 'v> =
- val mutable key: 'k
- val value: 'v
+ val mutable key : 'k
+ val value : 'v
new (k, v) = { key = k; value = v }
- override this.ToString () = sprintf "%A -> %A" this.key this.value
+ override this.ToString () = sprintf "%O -> %O" this.key this.value
/// <summary>
/// An heap min or max depending of the given key comparer.
type Heap<'k, 'v> (kComparer : IComparer<'k>) =
let a = List<Node<'k, 'v>>()
- let rec heapUp (i: int) =
+ let rec heapUp (i : int) =
let l, r = left i, right i
// Is the left child greater than the parent?
let mutable max = if l < a.Count && kComparer.Compare(a.[l].key, a.[i].key) > 0 then l else i
// Is the right child greater than the parent and the left child?
- if r < a.Count && kComparer.Compare(a.[r].key, a.[max].key) > 0
- then
+ if r < a.Count && kComparer.Compare(a.[r].key, a.[max].key) > 0 then
max <- r
// If a child is greater than the parent.
- if max <> i
- then
+ if max <> i then
let tmp = a.[i]
a.[i] <- a.[max]
a.[max] <- tmp
heapUp max
// Check the integrity of the heap, use for debug only.
- let rec checkIntegrity (i: int) : bool =
+ let rec checkIntegrity (i : int) : bool =
let l, r = left i, right i
let leftIntegrity =
- if l < a.Count
- then
- if kComparer.Compare(a.[l].key, a.[i].key) > 0
- then false
- else checkIntegrity l
+ if l < a.Count then
+ if kComparer.Compare(a.[l].key, a.[i].key) > 0 then false else checkIntegrity l
else
true
let rightIntegrity =
- if r < a.Count
- then
- if kComparer.Compare(a.[r].key, a.[i].key) > 0
- then false
- else checkIntegrity r
+ if r < a.Count then
+ if kComparer.Compare(a.[r].key, a.[i].key) > 0 then false else checkIntegrity r
else
true
leftIntegrity && rightIntegrity
a.RemoveAt(a.Count - 1)
heapUp 0
- member this.Add (key: 'k) (value: 'v) =
+ member this.Add (key : 'k) (value : 'v) =
a.Add(Node(key, value))
let mutable i = a.Count - 1
open Const
open Types
-let drawPoints (img: Image<Gray, 'TDepth>) (points: Points) (intensity: 'TDepth) =
+let drawPoints (img : Image<Gray, 'TDepth>) (points : Points) (intensity : 'TDepth) =
for p in points do
img.Data.[p.Y, p.X, 0] <- intensity
-let drawLine (img: Image<'TColor, 'TDepth>) (color: 'TColor) (x0: int) (y0: int) (x1: int) (y1: int) (thickness: int) =
+let drawLine (img : Image<'TColor, 'TDepth>) (color : 'TColor) (x0 : int) (y0 : int) (x1 : int) (y1 : int) (thickness : int) =
img.Draw(LineSegment2D(Point(x0, y0), Point(x1, y1)), color, thickness);
-let drawLineF (img: Image<'TColor, 'TDepth>) (color: 'TColor) (x0: float) (y0: float) (x1: float) (y1: float) (thickness: int) =
+let drawLineF (img : Image<'TColor, 'TDepth>) (color : 'TColor) (x0 : float) (y0 : float) (x1 : float) (y1 : float) (thickness : int) =
img.Draw(LineSegment2DF(PointF(float32 x0, float32 y0), PointF(float32 x1, float32 y1)), color, thickness, CvEnum.LineType.AntiAlias);
-let drawEllipse (img: Image<'TColor, 'TDepth>) (e: Ellipse) (color: 'TColor) (alpha: float) =
- if alpha >= 1.0
- then
+let drawEllipse (img : Image<'TColor, 'TDepth>) (e : Ellipse) (color : 'TColor) (alpha : float) =
+ if alpha >= 1.0 then
img.Draw(Emgu.CV.Structure.Ellipse(PointF(e.Cx, e.Cy), SizeF(2.f * e.B, 2.f * e.A), e.Alpha / PI * 180.f), color, 1, CvEnum.LineType.AntiAlias)
else
let windowPosX = e.Cx - e.A - 5.f
let roi = Rectangle(int windowPosX, int windowPosY, 2.f * (e.A + 5.f) |> int, 2.f * (e.A + 5.f) |> int)
img.ROI <- roi
- if roi = img.ROI // We do not display ellipses touching the edges (FIXME)
- then
+ if roi = img.ROI then // We do not display ellipses touching the edges (FIXME)
use i = new Image<'TColor, 'TDepth>(img.ROI.Size)
i.Draw(Emgu.CV.Structure.Ellipse(PointF(e.A + 5.f + gapX, e.A + 5.f + gapY), SizeF(2.f * e.B, 2.f * e.A), e.Alpha / PI * 180.f), color, 1, CvEnum.LineType.AntiAlias)
CvInvoke.AddWeighted(img, 1.0, i, alpha, 0.0, img)
img.ROI <- Rectangle.Empty
-let drawEllipses (img: Image<'TColor, 'TDepth>) (ellipses: Ellipse list) (color: 'TColor) (alpha: float) =
+let drawEllipses (img : Image<'TColor, 'TDepth>) (ellipses : Ellipse list) (color : 'TColor) (alpha : float) =
List.iter (fun e -> drawEllipse img e color alpha) ellipses
let rngCell = System.Random()
-let drawCell (img: Image<Bgr, byte>) (drawCellContent: bool) (c: Cell) =
- if drawCellContent
- then
+let drawCell (img : Image<Bgr, byte>) (drawCellContent : bool) (c : Cell) =
+ if drawCellContent then
let colorB = rngCell.Next(20, 70)
let colorG = rngCell.Next(20, 70)
let colorR = rngCell.Next(20, 70)
for y = 0 to c.elements.Height - 1 do
for x = 0 to c.elements.Width - 1 do
- if c.elements.[y, x] > 0uy
- then
+ if c.elements.[y, x] > 0uy then
let dx, dy = c.center.X - c.elements.Width / 2, c.center.Y - c.elements.Height / 2
let b = img.Data.[y + dy, x + dx, 0] |> int
let g = img.Data.[y + dy, x + dx, 1] |> int
drawLine img crossColor (c.center.X - 3) c.center.Y (c.center.X + 3) c.center.Y 1
drawLine img crossColor c.center.X (c.center.Y - 3) c.center.X (c.center.Y + 3) 1
-let drawCells (img: Image<Bgr, byte>) (drawCellContent: bool) (cells: Cell list) =
+let drawCells (img : Image<Bgr, byte>) (drawCellContent : bool) (cells : Cell list) =
List.iter (fun c -> drawCell img drawCellContent c) cells
\ No newline at end of file
/// The thresholds are automatically defined with otsu on gradient magnitudes.
/// </summary>
/// <param name="img"></param>
-let find (img: Image<Gray, float32>) : Matrix<byte> * Matrix<float32> * Matrix<float32> =
+let find (img : Image<Gray, float32>) : Matrix<byte> * Matrix<float32> * Matrix<float32> =
let w = img.Width
let h = img.Height
use sobelKernel =
- new Matrix<float32>(array2D [[ -1.0f; 0.0f; 1.0f ]
- [ -2.0f; 0.0f; 2.0f ]
- [ -1.0f; 0.0f; 1.0f ]])
+ new Matrix<float32>(
+ array2D [[ -1.0f; 0.0f; 1.0f ]
+ [ -2.0f; 0.0f; 2.0f ]
+ [ -1.0f; 0.0f; 1.0f ]]
+ )
let xGradient = new Matrix<float32>(img.Size)
let yGradient = new Matrix<float32>(img.Size)
for j = 1 to w - 2 do
let vx = xGradientData.[i, j]
let vy = yGradientData.[i, j]
- if vx <> 0.f || vy <> 0.f
- then
+ if vx <> 0.f || vy <> 0.f then
let angle = anglesData.[i, j]
let vx', vy' = abs vx, abs vy
let ratio2 = if vx' > vy' then vy' / vx' else vx' / vy'
let ratio1 = 1.f - ratio2
- let mNeigbors (sign: int) : float32 =
- if angle < PI / 4.f
- then ratio1 * magnitudesData.[i, j + sign] + ratio2 * magnitudesData.[i + sign, j + sign]
- elif angle < PI / 2.f
- then ratio2 * magnitudesData.[i + sign, j + sign] + ratio1 * magnitudesData.[i + sign, j]
- elif angle < 3.f * PI / 4.f
- then ratio1 * magnitudesData.[i + sign, j] + ratio2 * magnitudesData.[i + sign, j - sign]
- elif angle < PI
- then ratio2 * magnitudesData.[i + sign, j - sign] + ratio1 * magnitudesData.[i, j - sign]
- elif angle < 5.f * PI / 4.f
- then ratio1 * magnitudesData.[i, j - sign] + ratio2 * magnitudesData.[i - sign, j - sign]
- elif angle < 3.f * PI / 2.f
- then ratio2 * magnitudesData.[i - sign, j - sign] + ratio1 * magnitudesData.[i - sign, j]
- elif angle < 7.f * PI / 4.f
- then ratio1 * magnitudesData.[i - sign, j] + ratio2 * magnitudesData.[i - sign, j + sign]
- else ratio2 * magnitudesData.[i - sign, j + sign] + ratio1 * magnitudesData.[i, j + sign]
+ let mNeigbors (sign : int) : float32 =
+ if angle < PI / 4.f then
+ ratio1 * magnitudesData.[i, j + sign] + ratio2 * magnitudesData.[i + sign, j + sign]
+ elif angle < PI / 2.f then
+ ratio2 * magnitudesData.[i + sign, j + sign] + ratio1 * magnitudesData.[i + sign, j]
+ elif angle < 3.f * PI / 4.f then
+ ratio1 * magnitudesData.[i + sign, j] + ratio2 * magnitudesData.[i + sign, j - sign]
+ elif angle < PI then
+ ratio2 * magnitudesData.[i + sign, j - sign] + ratio1 * magnitudesData.[i, j - sign]
+ elif angle < 5.f * PI / 4.f then
+ ratio1 * magnitudesData.[i, j - sign] + ratio2 * magnitudesData.[i - sign, j - sign]
+ elif angle < 3.f * PI / 2.f then
+ ratio2 * magnitudesData.[i - sign, j - sign] + ratio1 * magnitudesData.[i - sign, j]
+ elif angle < 7.f * PI / 4.f then
+ ratio1 * magnitudesData.[i - sign, j] + ratio2 * magnitudesData.[i - sign, j + sign]
+ else
+ ratio2 * magnitudesData.[i - sign, j + sign] + ratio1 * magnitudesData.[i, j + sign]
let m = magnitudesData.[i, j]
- if m >= thresholdLow && m > mNeigbors 1 && m > mNeigbors -1
- then
+ if m >= thresholdLow && m > mNeigbors 1 && m > mNeigbors -1 then
nmsData.[i, j] <- 1uy
// suppressMConnections nms // It's not helpful for the rest of the process (ellipse detection).
let toVisit = Stack<Point>()
for i = 0 to h - 1 do
for j = 0 to w - 1 do
- if nmsData.[i, j] = 1uy && magnitudesData.[i, j] >= thresholdHigh
- then
+ if nmsData.[i, j] = 1uy && magnitudesData.[i, j] >= thresholdHigh then
nmsData.[i, j] <- 0uy
toVisit.Push(Point(j, i))
while toVisit.Count > 0 do
edgesData.[p.Y, p.X] <- 1uy
for i' = -1 to 1 do
for j' = -1 to 1 do
- if i' <> 0 || j' <> 0
- then
+ if i' <> 0 || j' <> 0 then
let ni = p.Y + i'
let nj = p.X + j'
- if ni >= 0 && ni < h && nj >= 0 && nj < w && nmsData.[ni, nj] = 1uy
- then
+ if ni >= 0 && ni < h && nj >= 0 && nj < w && nmsData.[ni, nj] = 1uy then
nmsData.[ni, nj] <- 0uy
toVisit.Push(Point(nj, ni))
open Emgu.CV
open Emgu.CV.Structure
-type Histogram = {
- data: int[]
- total: int // Number of elements.
- sum: int // Sum of all intensity.
- min: float32
- max: float32 }
-
-let histogramImg (img: Image<Gray, float32>) (nbSamples: int) : Histogram =
+type Histogram =
+ {
+ data : int[]
+ total : int // Number of elements.
+ sum : int // Sum of all intensity.
+ min : float32
+ max : float32
+ }
+
+let histogramImg (img : Image<Gray, float32>) (nbSamples : int) : Histogram =
let imgData = img.Data
let min, max =
img.MinMax(min, max, minLocation, maxLocation)
float32 (!min).[0], float32 (!max).[0]
- let inline bin (x: float32) : int =
+ let inline bin (x : float32) : int =
let p = int ((x - min) / (max - min) * float32 nbSamples)
if p >= nbSamples then nbSamples - 1 else p
{ data = data; total = img.Height * img.Width; sum = Array.sum data; min = min; max = max }
-let histogramMat (mat: Matrix<float32>) (nbSamples: int) : Histogram =
+let histogramMat (mat : Matrix<float32>) (nbSamples : int) : Histogram =
let matData = mat.Data
let min, max =
mat.MinMax(min, max, minLocation, maxLocation)
float32 !min, float32 !max
- let inline bin (x: float32) : int =
+ let inline bin (x : float32) : int =
let p = int ((x - min) / (max - min) * float32 nbSamples)
if p >= nbSamples then nbSamples - 1 else p
{ data = data; total = mat.Height * mat.Width; sum = Array.sum data; min = min; max = max }
-let histogram (values: float32 seq) (nbSamples: int) : Histogram =
+let histogram (values : float32 seq) (nbSamples : int) : Histogram =
let mutable min = Single.MaxValue
let mutable max = Single.MinValue
let mutable n = 0
if v < min then min <- v
if v > max then max <- v
- let inline bin (x: float32) : int =
+ let inline bin (x : float32) : int =
let p = int ((x - min) / (max - min) * float32 nbSamples)
if p >= nbSamples then nbSamples - 1 else p
open Emgu.CV
open Emgu.CV.Structure
-let saveImg (img: Image<'TColor, 'TDepth>) (filepath: string) =
+let saveImg (img : Image<'TColor, 'TDepth>) (filepath : string) =
img.Save(filepath)
-let saveMat (mat: Matrix<'TDepth>) (filepath: string) =
+let saveMat (mat : Matrix<'TDepth>) (filepath : string) =
use img = new Image<Gray, 'TDeph>(mat.Size)
mat.CopyTo(img)
saveImg img filepath
/// </summary>
/// <param name="img"></param>
/// <param name="upperLimit"></param>
-let normalize (img: Image<Gray, float32>) (upperLimit: float) : Image<Gray, float32> =
+let normalize (img : Image<Gray, float32>) (upperLimit : float) : Image<Gray, float32> =
let min = ref [| 0.0 |]
let minLocation = ref <| [| Point() |]
let max = ref [| 0.0 |]
let maxLocation = ref <| [| Point() |]
img.MinMax(min, max, minLocation, maxLocation)
let normalized = (img - (!min).[0]) / ((!max).[0] - (!min).[0])
- if upperLimit = 1.0
- then normalized
- else upperLimit * normalized
+ if upperLimit = 1.0 then
+ normalized
+ else
+ upperLimit * normalized
-let mergeChannels (img: Image<Bgr, float32>) (rgbWeights: float * float * float) : Image<Gray, float32> =
+let mergeChannels (img : Image<Bgr, float32>) (rgbWeights : float * float * float) : Image<Gray, float32> =
match rgbWeights with
| 1., 0., 0. -> img.[2]
| 0., 1., 0. -> img.[1]
CvInvoke.AddWeighted(result, 1., img.[0], blueFactor, 0., result)
result
-let mergeChannelsWithProjection (img: Image<Bgr, float32>) (v1r: float32, v1g: float32, v1b: float32) (v2r: float32, v2g: float32, v2b: float32) (upperLimit: float) : Image<Gray, float32> =
+let mergeChannelsWithProjection (img : Image<Bgr, float32>) (v1r : float32, v1g : float32, v1b : float32) (v2r : float32, v2g : float32, v2b : float32) (upperLimit : float) : Image<Gray, float32> =
let vr, vg, vb = v2r - v1r, v2g - v1g, v2b - v1b
let vMagnitude = sqrt (vr ** 2.f + vg ** 2.f + vb ** 2.f)
- let project (r: float32) (g: float32) (b: float32) = ((r - v1r) * vr + (g - v1g) * vg + (b - v1b) * vb) / vMagnitude
+ let project (r : float32) (g : float32) (b : float32) = ((r - v1r) * vr + (g - v1g) * vg + (b - v1b) * vb) / vMagnitude
let result = new Image<Gray, float32>(img.Size)
// TODO: Essayer en bindant Data pour gagner du temps
for i = 0 to img.Height - 1 do
normalize result upperLimit
// Normalize image values between 0uy and 255uy.
-let normalizeAndConvert (img: Image<Gray, 'TDepth>) : Image<Gray, byte> =
+let normalizeAndConvert (img : Image<Gray, 'TDepth>) : Image<Gray, byte> =
(normalize (img.Convert<Gray, float32>()) 255.).Convert<Gray, byte>()
let gaussianFilter (img : Image<'TColor, 'TDepth>) (standardDeviation : float) : Image<'TColor, 'TDepth> =
/// <summary>
/// Remove M-adjacent pixels. It may be used after thinning.
/// </summary>
-let suppressMAdjacency (img: Matrix<byte>) =
+let suppressMAdjacency (img : Matrix<byte>) =
let w = img.Width
let h = img.Height
for i = 1 to h - 2 do
for j = 1 to w - 2 do
- if img.[i, j] > 0uy && img.Data.[i + 1, j] > 0uy && (img.Data.[i, j - 1] > 0uy && img.Data.[i - 1, j + 1] = 0uy || img.Data.[i, j + 1] > 0uy && img.Data.[i - 1, j - 1] = 0uy)
- then
+ if img.[i, j] > 0uy && img.Data.[i + 1, j] > 0uy && (img.Data.[i, j - 1] > 0uy && img.Data.[i - 1, j + 1] = 0uy || img.Data.[i, j + 1] > 0uy && img.Data.[i - 1, j - 1] = 0uy) then
img.[i, j] <- 0uy
for i = 1 to h - 2 do
for j = 1 to w - 2 do
- if img.[i, j] > 0uy && img.Data.[i - 1, j] > 0uy && (img.Data.[i, j - 1] > 0uy && img.Data.[i + 1, j + 1] = 0uy || img.Data.[i, j + 1] > 0uy && img.Data.[i + 1, j - 1] = 0uy)
- then
+ if img.[i, j] > 0uy && img.Data.[i - 1, j] > 0uy && (img.Data.[i, j - 1] > 0uy && img.Data.[i + 1, j + 1] = 0uy || img.Data.[i, j + 1] > 0uy && img.Data.[i + 1, j - 1] = 0uy) then
img.[i, j] <- 0uy
type ExtremumType =
| Maxima = 1
| Minima = 2
-let findExtremum (img: Image<Gray, 'TDepth>) (extremumType: ExtremumType) : IEnumerable<Points> =
+let findExtremum (img : Image<Gray, 'TDepth>) (extremumType : ExtremumType) : IEnumerable<Points> =
let w = img.Width
let h = img.Height
let se = [| -1, 0; 0, -1; 1, 0; 0, 1 |]
let imgData = img.Data
- let suppress: bool[,] = Array2D.zeroCreate h w
+ let suppress : bool[,] = Array2D.zeroCreate h w
let result = List<List<Point>>()
- let flood (start: Point) : List<List<Point>> =
+ let flood (start : Point) : List<List<Point>> =
let sameLevelToCheck = Stack<Point>()
let betterLevelToCheck = Stack<Point>()
betterLevelToCheck.Push(start)
while betterLevelToCheck.Count > 0 do
let p = betterLevelToCheck.Pop()
- if not suppress.[p.Y, p.X]
- then
+ if not suppress.[p.Y, p.X] then
suppress.[p.Y, p.X] <- true
sameLevelToCheck.Push(p)
let current = List<Point>()
for i, j in se do
let ni = i + p'.Y
let nj = j + p'.X
- if ni >= 0 && ni < h && nj >= 0 && nj < w
- then
+ if ni >= 0 && ni < h && nj >= 0 && nj < w then
let level = imgData.[ni, nj, 0]
let notSuppressed = not suppress.[ni, nj]
- if level = currentLevel && notSuppressed
- then
+ if level = currentLevel && notSuppressed then
suppress.[ni, nj] <- true
sameLevelToCheck.Push(Point(nj, ni))
- elif if extremumType = ExtremumType.Maxima then level > currentLevel else level < currentLevel
- then
+ elif (if extremumType = ExtremumType.Maxima then level > currentLevel else level < currentLevel) then
betterExists <- true
- if notSuppressed
- then
+ if notSuppressed then
betterLevelToCheck.Push(Point(nj, ni))
- if not betterExists
- then
+ if not betterExists then
result'.Add(current)
result'
for i = 0 to h - 1 do
for j = 0 to w - 1 do
let maxima = flood (Point(j, i))
- if maxima.Count > 0
- then
+ if maxima.Count > 0 then
result.AddRange(maxima)
result.Select(fun l -> Points(l))
-let findMaxima (img: Image<Gray, 'TDepth>) : IEnumerable<Points> =
+let findMaxima (img : Image<Gray, 'TDepth>) : IEnumerable<Points> =
findExtremum img ExtremumType.Maxima
-let findMinima (img: Image<Gray, 'TDepth>) : IEnumerable<Points> =
+let findMinima (img : Image<Gray, 'TDepth>) : IEnumerable<Points> =
findExtremum img ExtremumType.Minima
type PriorityQueue () =
let size = 256
- let q: Points[] = Array.init size (fun i -> Points())
+ let q : Points[] = Array.init size (fun i -> Points())
let mutable highest = -1 // Value of the first elements of 'q'.
let mutable lowest = size
member this.NextMax () : byte * Point =
- if this.IsEmpty
- then
+ if this.IsEmpty then
invalidOp "Queue is empty"
else
let l = q.[highest]
l.Remove(next) |> ignore
let value = byte highest
- if l.Count = 0
- then
+ if l.Count = 0 then
highest <- highest - 1
while highest > lowest && q.[highest].Count = 0 do
highest <- highest - 1
- if highest = lowest
- then
+ if highest = lowest then
highest <- -1
lowest <- size
value, next
member this.NextMin () : byte * Point =
- if this.IsEmpty
- then
+ if this.IsEmpty then
invalidOp "Queue is empty"
else
let l = q.[lowest + 1]
l.Remove(next) |> ignore
let value = byte (lowest + 1)
- if l.Count = 0
- then
+ if l.Count = 0 then
lowest <- lowest + 1
while lowest < highest && q.[lowest + 1].Count = 0 do
lowest <- lowest + 1
- if highest = lowest
- then
+ if highest = lowest then
highest <- -1
lowest <- size
member this.Min =
lowest + 1 |> byte
- member this.Add (value: byte) (p: Point) =
+ member this.Add (value : byte) (p : Point) =
let vi = int value
- if vi > highest
- then
+ if vi > highest then
highest <- vi
- if vi <= lowest
- then
+ if vi <= lowest then
lowest <- vi - 1
q.[vi].Add(p) |> ignore
- member this.Remove (value: byte) (p: Point) =
+ member this.Remove (value : byte) (p : Point) =
let vi = int value
- if q.[vi].Remove(p) && q.[vi].Count = 0
- then
- if vi = highest
- then
+ if q.[vi].Remove(p) && q.[vi].Count = 0 then
+ if vi = highest then
highest <- highest - 1
while highest > lowest && q.[highest].Count = 0 do
highest <- highest - 1
- elif vi - 1 = lowest
- then
+ elif vi - 1 = lowest then
lowest <- lowest + 1
while lowest < highest && q.[lowest + 1].Count = 0 do
lowest <- lowest + 1
- if highest = lowest // The queue is now empty.
- then
+ if highest = lowest then // The queue is now empty.
highest <- -1
lowest <- size
| Closing = 2
[<AllowNullLiteral>]
-type private Area (elements: Points) =
+type private Area (elements : Points) =
member this.Elements = elements
member val Intensity = None with get, set
member val State = AreaState.Unprocessed with get, set
-let private areaOperation (img: Image<Gray, byte>) (area: int) (op: AreaOperation) =
+let private areaOperation (img : Image<Gray, byte>) (area : int) (op : AreaOperation) =
let w = img.Width
let h = img.Height
let imgData = img.Data
let areas = List<Area>((if op = AreaOperation.Opening then findMaxima img else findMinima img) |> Seq.map Area)
- let pixels: Area[,] = Array2D.create h w null
+ let pixels : Area[,] = Array2D.create h w null
for m in areas do
for e in m.Elements do
pixels.[e.Y, e.X] <- m
let queue = PriorityQueue()
- let addEdgeToQueue (elements: Points) =
+ let addEdgeToQueue (elements : Points) =
for p in elements do
for i, j in se do
let ni = i + p.Y
let nj = j + p.X
let p' = Point(nj, ni)
- if ni >= 0 && ni < h && nj >= 0 && nj < w && not (elements.Contains(p'))
- then
+ if ni >= 0 && ni < h && nj >= 0 && nj < w && not (elements.Contains(p')) then
queue.Add (imgData.[ni, nj, 0]) p'
// Reverse order is quicker.
for i = areas.Count - 1 downto 0 do
let m = areas.[i]
- if m.Elements.Count <= area && m.State <> AreaState.Removed
- then
+ if m.Elements.Count <= area && m.State <> AreaState.Removed then
queue.Clear()
addEdgeToQueue m.Elements
let intensity', p = if op = AreaOperation.Opening then queue.NextMax () else queue.NextMin ()
let mutable merged = false
- if intensity' = intensity // The intensity doesn't change.
- then
- if m.Elements.Count + nextElements.Count + 1 > area
- then
+ if intensity' = intensity then // The intensity doesn't change.
+ if m.Elements.Count + nextElements.Count + 1 > area then
m.State <- AreaState.Validated
m.Intensity <- Some intensity
stop <- true
else
nextElements.Add(p) |> ignore
- elif if op = AreaOperation.Opening then intensity' < intensity else intensity' > intensity
- then
+ elif (if op = AreaOperation.Opening then intensity' < intensity else intensity' > intensity) then
m.Elements.UnionWith(nextElements)
for e in nextElements do
pixels.[e.Y, e.X] <- m
- if m.Elements.Count = area
- then
+ if m.Elements.Count = area then
m.State <- AreaState.Validated
m.Intensity <- Some (intensity')
stop <- true
match pixels.[p.Y, p.X] with
| null -> ()
| m' ->
- if m'.Elements.Count + m.Elements.Count <= area
- then
+ if m'.Elements.Count + m.Elements.Count <= area then
m'.State <- AreaState.Removed
for e in m'.Elements do
pixels.[e.Y, e.X] <- m
addEdgeToQueue m'.Elements
m.Elements.UnionWith(m'.Elements)
let intensityMax = if op = AreaOperation.Opening then queue.Max else queue.Min
- if intensityMax <> intensity
- then
+ if intensityMax <> intensity then
intensity <- intensityMax
nextElements.Clear()
merged <- true
- if not merged
- then
+ if not merged then
m.State <- AreaState.Validated
m.Intensity <- Some (intensity)
stop <- true
- if not stop && not merged
- then
+ if not stop && not merged then
for i, j in se do
let ni = i + p.Y
let nj = j + p.X
let p' = Point(nj, ni)
- if ni < 0 || ni >= h || nj < 0 || nj >= w
- then
+ if ni < 0 || ni >= h || nj < 0 || nj >= w then
m.State <- AreaState.Validated
m.Intensity <- Some (intensity)
stop <- true
- elif not (m.Elements.Contains(p')) && not (nextElements.Contains(p'))
- then
+ elif not (m.Elements.Contains(p')) && not (nextElements.Contains(p')) then
queue.Add (imgData.[ni, nj, 0]) p'
- if queue.IsEmpty
- then
- if m.Elements.Count + nextElements.Count <= area
- then
+ if queue.IsEmpty then
+ if m.Elements.Count + nextElements.Count <= area then
m.State <- AreaState.Validated
m.Intensity <- Some intensity'
m.Elements.UnionWith(nextElements)
stop <- true
for m in areas do
- if m.State = AreaState.Validated
- then
+ if m.State = AreaState.Validated then
match m.Intensity with
| Some i ->
for p in m.Elements do
/// <summary>
/// Area opening on byte image.
/// </summary>
-let areaOpen (img: Image<Gray, byte>) (area: int) =
+let areaOpen (img : Image<Gray, byte>) (area : int) =
areaOperation img area AreaOperation.Opening
/// <summary>
/// Area closing on byte image.
/// </summary>
-let areaClose (img: Image<Gray, byte>) (area: int) =
+let areaClose (img : Image<Gray, byte>) (area : int) =
areaOperation img area AreaOperation.Closing
// A simpler algorithm than 'areaOpen' on byte image but slower.
-let areaOpen2 (img: Image<Gray, byte>) (area: int) =
+let areaOpen2 (img : Image<Gray, byte>) (area : int) =
let w = img.Width
let h = img.Height
let imgData = img.Data
for level = 255 downto 0 do
let mutable n = histogram.[level]
- if n > 0
- then
+ if n > 0 then
for i = 0 to h - 1 do
for j = 0 to w - 1 do
- if not flooded.[i, j] && imgData.[i, j, 0] = byte level
- then
+ if not flooded.[i, j] && imgData.[i, j, 0] = byte level then
let mutable maxNeighborValue = 0uy
pointsChecked.Clear()
pointsToCheck.Clear()
for nx, ny in se do
let p = Point(next.X + nx, next.Y + ny)
- if p.X >= 0 && p.X < w && p.Y >= 0 && p.Y < h
- then
+ if p.X >= 0 && p.X < w && p.Y >= 0 && p.Y < h then
let v = imgData.[p.Y, p.X, 0]
- if v = byte level
- then
- if not (pointsChecked.Contains(p))
- then
+ if v = byte level then
+ if not (pointsChecked.Contains(p)) then
pointsToCheck.Push(p)
- elif v > maxNeighborValue
- then
+ elif v > maxNeighborValue then
maxNeighborValue <- v
- if int maxNeighborValue < level && pointsChecked.Count <= area
- then
+ if int maxNeighborValue < level && pointsChecked.Count <= area then
for p in pointsChecked do
imgData.[p.Y, p.X, 0] <- maxNeighborValue
[<AllowNullLiteral>]
-type Island (cmp: IComparer<float32>) =
+type Island (cmp : IComparer<float32>) =
member val Shore = Heap.Heap<float32, Point>(cmp) with get
member val Level = 0.f with get, set
member val Surface = 0 with get, set
member this.IsInfinite = this.Surface = Int32.MaxValue
-let private areaOperationF (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: ('a -> float32 -> unit) option) (op: AreaOperation) =
+let private areaOperationF (img : Image<Gray, float32>) (areas : (int * 'a) list) (f : ('a -> float32 -> unit) option) (op : AreaOperation) =
let w = img.Width
let h = img.Height
let earth = img.Data
let se = [| -1, 0; 0, -1; 1, 0; 0, 1 |]
- let comparer = if op = AreaOperation.Opening
- then { new IComparer<float32> with member this.Compare(v1, v2) = v1.CompareTo(v2) }
- else { new IComparer<float32> with member this.Compare(v1, v2) = v2.CompareTo(v1) }
+ let comparer =
+ if op = AreaOperation.Opening then
+ { new IComparer<float32> with member this.Compare(v1, v2) = v1.CompareTo(v2) }
+ else
+ { new IComparer<float32> with member this.Compare(v1, v2) = v2.CompareTo(v1) }
- let ownership: Island[,] = Array2D.create h w null
+ let ownership : Island[,] = Array2D.create h w null
// Initialize islands with their shore.
let islands = List<Island>()
let ni = i + p.Y
let nj = j + p.X
let neighbor = Point(nj, ni)
- if ni >= 0 && ni < h && nj >= 0 && nj < w && Object.ReferenceEquals(ownership.[ni, nj], null) && not (shorePoints.Contains(neighbor))
- then
+ if ni >= 0 && ni < h && nj >= 0 && nj < w && Object.ReferenceEquals(ownership.[ni, nj], null) && not (shorePoints.Contains(neighbor)) then
shorePoints.Add(neighbor) |> ignore
island.Shore.Add earth.[ni, nj, 0] neighbor
let mutable stop = island.Shore.IsEmpty
// 'true' if 'p' is owned or adjacent to 'island'.
- let inline ownedOrAdjacent (p: Point) : bool =
+ let inline ownedOrAdjacent (p : Point) : bool =
ownership.[p.Y, p.X] = island ||
(p.Y > 0 && ownership.[p.Y - 1, p.X] = island) ||
(p.Y < h - 1 && ownership.[p.Y + 1, p.X] = island) ||
while not stop && island.Surface < area do
let level, next = island.Shore.Max
let other = ownership.[next.Y, next.X]
- if other = island // During merging, some points on the shore may be owned by the island itself -> ignored.
- then
+ if other = island then // During merging, some points on the shore may be owned by the island itself -> ignored.
island.Shore.RemoveNext ()
else
- if not <| Object.ReferenceEquals(other, null)
- then // We touching another island.
- if island.IsInfinite || other.IsInfinite || island.Surface + other.Surface >= area || comparer.Compare(island.Level, other.Level) < 0
- then
+ if not <| Object.ReferenceEquals(other, null) then
+ // We touching another island.
+ if island.IsInfinite || other.IsInfinite || island.Surface + other.Surface >= area || comparer.Compare(island.Level, other.Level) < 0 then
stop <- true
else // We can merge 'other' into 'surface'.
island.Surface <- island.Surface + other.Surface
island.Shore.Add l p
other.Shore.Clear()
- elif comparer.Compare(level, island.Level) > 0
- then
+ elif comparer.Compare(level, island.Level) > 0 then
stop <- true
else
island.Shore.RemoveNext ()
for i, j in se do
let ni = i + next.Y
let nj = j + next.X
- if ni < 0 || ni >= h || nj < 0 || nj >= w
- then
+ if ni < 0 || ni >= h || nj < 0 || nj >= w then
island.Surface <- Int32.MaxValue
stop <- true
else
let neighbor = Point(nj, ni)
- if not <| ownedOrAdjacent neighbor
- then
+ if not <| ownedOrAdjacent neighbor then
island.Shore.Add earth.[ni, nj, 0] neighbor
- if not stop
- then
+ if not stop then
ownership.[next.Y, next.X] <- island
island.Level <- level
island.Surface <- island.Surface + 1
/// <summary>
/// Area opening on float image.
/// </summary>
-let areaOpenF (img: Image<Gray, float32>) (area: int) =
+let areaOpenF (img : Image<Gray, float32>) (area : int) =
areaOperationF img [ area, () ] None AreaOperation.Opening
/// <summary>
/// Area closing on float image.
/// </summary>
-let areaCloseF (img: Image<Gray, float32>) (area: int) =
+let areaCloseF (img : Image<Gray, float32>) (area : int) =
areaOperationF img [ area, () ] None AreaOperation.Closing
/// <summary>
/// For each area the function 'f' is called with the associated area value of type 'a and the volume difference
/// Between the previous and the current closing.
/// </summary>
-let areaOpenFWithFun (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: 'a -> float32 -> unit) =
+let areaOpenFWithFun (img : Image<Gray, float32>) (areas : (int * 'a) list) (f : 'a -> float32 -> unit) =
areaOperationF img areas (Some f) AreaOperation.Opening
/// <summary>
/// Same as 'areaOpenFWithFun' for closing operation.
/// </summary>
-let areaCloseFWithFun (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: 'a -> float32 -> unit) =
+let areaCloseFWithFun (img : Image<Gray, float32>) (areas : (int * 'a) list) (f : 'a -> float32 -> unit) =
areaOperationF img areas (Some f) AreaOperation.Closing
/// <summary>
/// Zhang and Suen thinning algorithm.
/// Modify 'mat' in place.
/// </summary>
-let thin (mat: Matrix<byte>) =
+let thin (mat : Matrix<byte>) =
let w = mat.Width
let h = mat.Height
let mutable data1 = mat.Data
pixelChanged <- false
for i = 0 to h - 1 do
for j = 0 to w - 1 do
- if data1.[i, j] = 1uy
- then
+ if data1.[i, j] = 1uy then
let p2 = if i = 0 then 0uy else data1.[i-1, j]
let p3 = if i = 0 || j = w-1 then 0uy else data1.[i-1, j+1]
let p4 = if j = w-1 then 0uy else data1.[i, j+1]
(if p7 = 0uy && p8 = 1uy then 1 else 0) +
(if p8 = 0uy && p9 = 1uy then 1 else 0) +
(if p9 = 0uy && p2 = 1uy then 1 else 0) = 1 &&
- if oddIteration
- then p2 * p4 * p6 = 0uy && p4 * p6 * p8 = 0uy
- else p2 * p4 * p8 = 0uy && p2 * p6 * p8 = 0uy
+ if oddIteration then
+ p2 * p4 * p6 = 0uy && p4 * p6 * p8 = 0uy
+ else
+ p2 * p4 * p8 = 0uy && p2 * p6 * p8 = 0uy
then
data2.[i, j] <- 0uy
pixelChanged <- true
/// Remove all 8-connected pixels with an area equal or greater than 'areaSize'.
/// Modify 'mat' in place.
/// </summary>
-let removeArea (mat: Matrix<byte>) (areaSize: int) =
+let removeArea (mat : Matrix<byte>) (areaSize : int) =
let neighbors = [|
(-1, 0) // p2
(-1, 1) // p3
for i = 0 to h - 1 do
for j = 0 to w - 1 do
- if data'.[i, j] = 1uy
- then
+ if data'.[i, j] = 1uy then
let neighborhood = List<Point>()
let neighborsToCheck = Stack<Point>()
neighborsToCheck.Push(Point(j, i))
for (ni, nj) in neighbors do
let pi = n.Y + ni
let pj = n.X + nj
- if pi >= 0 && pi < h && pj >= 0 && pj < w && data'.[pi, pj] = 1uy
- then
+ if pi >= 0 && pi < h && pj >= 0 && pj < w && data'.[pi, pj] = 1uy then
neighborsToCheck.Push(Point(pj, pi))
data'.[pi, pj] <- 0uy
- if neighborhood.Count <= areaSize
- then
+ if neighborhood.Count <= areaSize then
for n in neighborhood do
data.[n.Y, n.X] <- 0uy
-let connectedComponents (img: Image<Gray, byte>) (startPoints: List<Point>) : Points =
+let connectedComponents (img : Image<Gray, byte>) (startPoints : List<Point>) : Points =
let w = img.Width
let h = img.Height
pointChecked.Add(next) |> ignore
for ny = -1 to 1 do
for nx = -1 to 1 do
- if ny <> 0 && nx <> 0
- then
+ if ny <> 0 && nx <> 0 then
let p = Point(next.X + nx, next.Y + ny)
- if p.X >= 0 && p.X < w && p.Y >= 0 && p.Y < h && data.[p.Y, p.X, 0] > 0uy && not (pointChecked.Contains p)
- then
+ if p.X >= 0 && p.X < w && p.Y >= 0 && p.Y < h && data.[p.Y, p.X, 0] > 0uy && not (pointChecked.Contains p) then
pointToCheck.Push(p)
pointChecked
open Histogram
-let otsu (hist: Histogram) : float32 * float32 * float32 =
+let otsu (hist : Histogram) : float32 * float32 * float32 =
let mutable sumB = 0
let mutable wB = 0
let mutable maximum = 0.0
for i = 0 to hist.data.Length - 1 do
wB <- wB + hist.data.[i]
- if wB <> 0
- then
+ if wB <> 0 then
let wF = hist.total - wB
- if wF <> 0
- then
+ if wF <> 0 then
sumB <- sumB + i * hist.data.[i]
let mB = (float sumB) / (float wB)
let mF = (sum - float sumB) / (float wF)
let between = (float wB) * (float wF) * (mB - mF) ** 2.;
- if between >= maximum
- then
+ if between >= maximum then
level <- i
maximum <- between
open Emgu.CV
open Emgu.CV.Structure
-type Result = {
- fg: Image<Gray, byte>
- mean_bg: float32
- mean_fg: float32
- d_fg: Image<Gray, float32> } // Euclidean distances of the foreground to mean_fg.
-
-let kmeans (img: Image<Gray, float32>) : Result =
+type Result =
+ {
+ fg : Image<Gray, byte>
+ mean_bg : float32
+ mean_fg : float32
+ d_fg : Image<Gray, float32> // Euclidean distances of the foreground to mean_fg.
+ }
+
+let kmeans (img : Image<Gray, float32>) : Result =
let nbIteration = 4
let w = img.Width
let h = img.Height
for i = 0 to h - 1 do
for j = 0 to w - 1 do
- if fgData.[i, j, 0] > 0uy
- then
+ if fgData.[i, j, 0] > 0uy then
fg_total <- fg_total + imgData.[i, j, 0]
fg_nb <- fg_nb + 1
else
open Emgu.CV
open Emgu.CV.Structure
-type Result = {
- fg: Image<Gray, byte>
- median_bg: float
- median_fg: float
- d_fg: Image<Gray, float32> } // Euclidean distances of the foreground to median_fg.
-
-let kmedians (img: Image<Gray, float32>) : Result =
+type Result =
+ {
+ fg : Image<Gray, byte>
+ median_bg : float
+ median_fg : float
+ d_fg : Image<Gray, float32> // Euclidean distances of the foreground to median_fg.
+ }
+
+let kmedians (img : Image<Gray, float32>) : Result =
let nbIteration = 4
let w = img.Width
let h = img.Height
for i = 0 to h - 1 do
for j = 0 to w - 1 do
- if fg.Data.[i, j, 0] > 0uy
- then fg_values.Add(float img.Data.[i, j, 0])
- else bg_values.Add(float img.Data.[i, j, 0])
+ if fg.Data.[i, j, 0] > 0uy then
+ fg_values.Add(float img.Data.[i, j, 0])
+ else
+ bg_values.Add(float img.Data.[i, j, 0])
median_bg <- MathNet.Numerics.Statistics.Statistics.Median(bg_values)
median_fg <- MathNet.Numerics.Statistics.Statistics.Median(fg_values)
abstract Y : float32
// Compare 'e1' and 'e2' by X.
-let cmpX (e1: I2DCoords) (e2: I2DCoords) : int =
+let cmpX (e1 : I2DCoords) (e2 : I2DCoords) : int =
match e1.X.CompareTo(e2.X) with
| 0 -> match e1.Y.CompareTo(e2.Y) with
| 0 -> e1.GetHashCode().CompareTo(e2.GetHashCode())
| v -> v
// Compare 'e1' and 'e2' by Y.
-let cmpY (e1: I2DCoords) (e2: I2DCoords) : int =
+let cmpY (e1 : I2DCoords) (e2 : I2DCoords) : int =
match e1.Y.CompareTo(e2.Y) with
| 0 -> match e1.X.CompareTo(e2.X) with
| 0 -> e1.GetHashCode().CompareTo(e2.GetHashCode())
| v -> v
| v -> v
-type Region = { minX: float32; maxX: float32; minY: float32; maxY: float32 } with
+type Region = { minX : float32; maxX : float32; minY : float32; maxY : float32 } with
member this.Contains px py : bool =
px >= this.minX && px <= this.maxX &&
py >= this.minY && py <= this.maxY
| Node of float32 * Tree<'a> * Tree<'a>
| Leaf of 'a
- static member BuildTree (l: 'a list) : Tree<'a> =
+ static member BuildTree (l : 'a list) : Tree<'a> =
let xSorted = List.toArray l
let ySorted = List.toArray l
Array.sortInPlaceWith cmpX xSorted
Array.sortInPlaceWith cmpY ySorted
- let rec buildTreeFromSortedArray (pXSorted: 'a[]) (pYSorted: 'a[]) (depth: int) : Tree<'a> =
- if pXSorted.Length = 1
- then
+ let rec buildTreeFromSortedArray (pXSorted : 'a[]) (pYSorted : 'a[]) (depth : int) : Tree<'a> =
+ if pXSorted.Length = 1 then
Leaf pXSorted.[0]
else
- if depth % 2 = 1 // 'depth' is odd -> vertical splitting else horizontal splitting.
- then
+ if depth % 2 = 1 then // 'depth' is odd -> vertical splitting else horizontal splitting.
let leftX, rightX = Array.splitAt ((pXSorted.Length + 1) / 2) pXSorted
let splitElement = Array.last leftX
- let leftY, rightY = Array.partition (fun (e: 'a) -> cmpX e splitElement <= 0) pYSorted // FIXME: Maybe this operation can be optimized.
+ let leftY, rightY = Array.partition (fun (e : 'a) -> cmpX e splitElement <= 0) pYSorted // FIXME: Maybe this operation can be optimized.
Node (splitElement.X, buildTreeFromSortedArray leftX leftY (depth + 1), buildTreeFromSortedArray rightX rightY (depth + 1))
else
let downY, upY = Array.splitAt ((pYSorted.Length + 1) / 2) pYSorted
let splitElement = Array.last downY
- let downX, upX = Array.partition (fun (e: 'a) -> cmpY e splitElement <= 0) pXSorted // FIXME: Maybe this operation can be optimized.
+ let downX, upX = Array.partition (fun (e : 'a) -> cmpY e splitElement <= 0) pXSorted // FIXME: Maybe this operation can be optimized.
Node (splitElement.Y, buildTreeFromSortedArray downX downY (depth + 1), buildTreeFromSortedArray upX upY (depth + 1))
buildTreeFromSortedArray xSorted ySorted 1
- member this.Search (searchRegion: Region) : 'a list =
- let rec valuesFrom (tree: Tree<'a>) (acc: 'a list) : 'a list =
+ member this.Search (searchRegion : Region) : 'a list =
+ let rec valuesFrom (tree : Tree<'a>) (acc : 'a list) : 'a list =
match tree with
| Node (_, left, right) -> (valuesFrom right (valuesFrom left acc))
| Leaf v -> v :: acc
- let rec searchWithRegion (tree: Tree<'a>) (currentRegion: Region) (depth: int) : 'a list =
+ let rec searchWithRegion (tree : Tree<'a>) (currentRegion : Region) (depth : int) : 'a list =
match tree with
| Leaf v -> if searchRegion.Contains v.X v.Y then [v] else []
| Node (splitValue, part1, part2) ->
- let valuesInRegion (region: Region) (treeRegion: Tree<'a>) =
- if region.IsSub searchRegion
- then
+ let valuesInRegion (region : Region) (treeRegion : Tree<'a>) =
+ if region.IsSub searchRegion then
valuesFrom treeRegion []
- elif region.Intersects searchRegion
- then
+ elif region.Intersects searchRegion then
searchWithRegion treeRegion region (depth + 1)
else
[]
- if depth % 2 = 1 // Vertical splitting.
- then
+ if depth % 2 = 1 then // Vertical splitting.
let leftRegion = { currentRegion with maxX = splitValue }
let rightRegion = { currentRegion with minX = splitValue }
(valuesInRegion leftRegion part1) @ (valuesInRegion rightRegion part2)
///// Tests. TODO: to put in a unit test.
-type Point (x: float32, y: float32) =
+type Point (x : float32, y : float32) =
interface I2DCoords with
member this.X = x
member this.Y = y
// TODO: test with identical X or Y coords
let test () =
- let pts = [
- Point(1.0f, 1.0f)
- Point(2.0f, 2.0f)
- Point(1.5f, 3.6f)
- Point(3.0f, 3.2f)
- Point(4.0f, 4.0f)
- Point(3.5f, 1.5f)
- Point(2.5f, 0.5f) ]
+ let pts =
+ [
+ Point(1.0f, 1.0f)
+ Point(2.0f, 2.0f)
+ Point(1.5f, 3.6f)
+ Point(3.0f, 3.2f)
+ Point(4.0f, 4.0f)
+ Point(3.5f, 1.5f)
+ Point(2.5f, 0.5f)
+ ]
let tree = Tree.BuildTree pts
Utils.dprintfn "Tree: %A" tree
Utils.dprintfn "s3: %A" s3
let test2 () =
- let pts = [
- Point(1.0f, 1.0f)
- Point(1.0f, 2.0f)
- Point(1.0f, 3.0f) ]
+ let pts =
+ [
+ Point(1.0f, 1.0f)
+ Point(1.0f, 2.0f)
+ Point(1.0f, 3.0f)
+ ]
let tree = Tree.BuildTree pts
Utils.dprintfn "Tree: %A" tree
let matchingScorePower = 20.f
let windowSizeRadiusFactor = 1.f / 2.f // Used when searching for neighbor ellipses.
let minimumDistanceFromCenterRadiusFactor = 1.f / 3.f
-let minimumAreaFactor = 1.1f;
+let minimumAreaFactor = 1.1f
-type private EllipseScoreFlaggedKd (matchingScore: float32, e: Ellipse) =
+type private EllipseScoreFlaggedKd (matchingScore : float32, e : Ellipse) =
let mutable matchingScore = matchingScore
member this.Ellipse = e
member this.MatchingScore = matchingScore
- member this.AddMatchingScore (score: float32) =
+ member this.AddMatchingScore (score : float32) =
matchingScore <- matchingScore + score
member val Processed = false with get, set
member this.X = this.Ellipse.Cx
member this.Y = this.Ellipse.Cy
-type MatchingEllipses (radius: float32) =
+type MatchingEllipses (radius : float32) =
let ellipses = List<EllipseScoreFlaggedKd>()
- member this.Add (e: Ellipse) =
+ member this.Add (e : Ellipse) =
ellipses.Add(EllipseScoreFlaggedKd(0.f, e))
member this.Ellipses : Ellipse list =
List.ofSeq ellipses |> List.map (fun e -> e.Ellipse)
member this.PrunedEllipses : Ellipse list =
- if ellipses.Count = 0
- then
+ if ellipses.Count = 0 then
[]
else
// 1) Create a kd-tree from the ellipses list.
for e in ellipses do
e.Processed <- true
let areaE = e.Ellipse.Area
- let window = { KdTree.minX = e.Ellipse.Cx - windowSize / 2.f
- KdTree.maxX = e.Ellipse.Cx + windowSize / 2.f
- KdTree.minY = e.Ellipse.Cy - windowSize / 2.f
- KdTree.maxY = e.Ellipse.Cy + windowSize / 2.f }
+ let window =
+ {
+ KdTree.minX = e.Ellipse.Cx - windowSize / 2.f
+ KdTree.maxX = e.Ellipse.Cx + windowSize / 2.f
+ KdTree.minY = e.Ellipse.Cy - windowSize / 2.f
+ KdTree.maxY = e.Ellipse.Cy + windowSize / 2.f
+ }
for other in tree.Search window do
- if not other.Processed
- then
+ if not other.Processed then
let areaOther = other.Ellipse.Area
match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
| Some (overlapArea, _, _)
// 3) Remove ellipses whose center is near the center of another ellipse with a better score.
let matchingScoreThreshold = matchingScoreThresholdPerRadiusUnit * radius
for e in ellipses do
- if e.MatchingScore < matchingScoreThreshold
- then
+ if e.MatchingScore < matchingScoreThreshold then
e.Removed <- true
else
- let window = { KdTree.minX = e.Ellipse.Cx - e.Ellipse.A
- KdTree.maxX = e.Ellipse.Cx + e.Ellipse.A
- KdTree.minY = e.Ellipse.Cy - e.Ellipse.A
- KdTree.maxY = e.Ellipse.Cy + e.Ellipse.A }
+ let window =
+ {
+ KdTree.minX = e.Ellipse.Cx - e.Ellipse.A
+ KdTree.maxX = e.Ellipse.Cx + e.Ellipse.A
+ KdTree.minY = e.Ellipse.Cy - e.Ellipse.A
+ KdTree.maxY = e.Ellipse.Cy + e.Ellipse.A
+ }
for other in tree.Search window do
- if not other.Removed && e.MatchingScore > other.MatchingScore
- then
+ if not other.Removed && e.MatchingScore > other.MatchingScore then
// Case where ellipses are too close.
- if distanceTwoPoints (PointF(e.Ellipse.Cx, e.Ellipse.Cy)) (PointF(other.Ellipse.Cx, other.Ellipse.Cy)) < minimumDistanceFromCenterRadiusFactor * e.Ellipse.B
- then
+ if distanceTwoPoints (PointF(e.Ellipse.Cx, e.Ellipse.Cy)) (PointF(other.Ellipse.Cx, other.Ellipse.Cy)) < minimumDistanceFromCenterRadiusFactor * e.Ellipse.B then
other.Removed <- true
else
// Case where ellipses are overlapped.
<OutputType>Library</OutputType>
<RootNamespace>ParasitemiaCore</RootNamespace>
<AssemblyName>ParasitemiaCore</AssemblyName>
- <TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
- <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
+ <TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
+ <TargetFSharpCoreVersion>4.4.1.0</TargetFSharpCoreVersion>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<Name>ParasitemiaCore</Name>
<TargetFrameworkProfile />
<Content Include="packages.config" />
</ItemGroup>
<ItemGroup>
- <Reference Include="Emgu.CV">
- <HintPath>..\..\..\Emgu\emgucv-windows-universal 3.0.0.2157\bin\Emgu.CV.dll</HintPath>
- </Reference>
- <Reference Include="Emgu.Util">
- <HintPath>..\..\..\Emgu\emgucv-windows-universal 3.0.0.2157\bin\Emgu.Util.dll</HintPath>
+ <Reference Include="Emgu.CV.World">
+ <HintPath>..\..\..\Emgu\emgucv-windesktop 3.1.0.2282\bin\Emgu.CV.World.dll</HintPath>
</Reference>
<Reference Include="FSharp.Collections.ParallelSeq">
<HintPath>..\packages\FSharp.Collections.ParallelSeq.1.0.2\lib\net40\FSharp.Collections.ParallelSeq.dll</HintPath>
<Private>True</Private>
</Reference>
- <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion)">
+ <Reference Include="FSharp.Core, Version=4.4.1.0">
<HintPath>..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll</HintPath>
<Private>True</Private>
</Reference>
<Reference Include="MathNet.Numerics">
- <HintPath>..\packages\MathNet.Numerics.3.10.0\lib\net40\MathNet.Numerics.dll</HintPath>
- <Private>True</Private>
+ <HintPath>..\packages\MathNet.Numerics.3.17.0\lib\net40\MathNet.Numerics.dll</HintPath>
</Reference>
<Reference Include="MathNet.Numerics.FSharp">
- <HintPath>..\packages\MathNet.Numerics.FSharp.3.10.0\lib\net40\MathNet.Numerics.FSharp.dll</HintPath>
- <Private>True</Private>
+ <HintPath>..\packages\MathNet.Numerics.FSharp.3.17.0\lib\net40\MathNet.Numerics.FSharp.dll</HintPath>
</Reference>
<Reference Include="mscorlib" />
<Reference Include="System" />
<Reference Include="System.Core" />
<Reference Include="System.Drawing" />
<Reference Include="System.Numerics" />
+ <Reference Include="System.ValueTuple">
+ <HintPath>..\packages\System.ValueTuple.4.3.0\lib\netstandard1.0\System.ValueTuple.dll</HintPath>
+ </Reference>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Logger\Logger.fsproj">
open Morpho
open ImgTools
-type Result = {
- darkStain: Image<Gray, byte> // Colored pixel, it's independent of the size of the areas. It corresponds to white cells, schizontes, gametocytes, throphozoites.
- nucleus: Image<Gray, byte> // Parasite nucleus. It may contain some debris. It shouldn't contain thrombocytes or larger elements.
- parasite: Image<Gray, byte> } // The whole parasites.
+type Result =
+ {
+ darkStain : Image<Gray, byte> // Colored pixel, it's independent of the size of the areas. It corresponds to white cells, schizontes, gametocytes, throphozoites.
+ nucleus : Image<Gray, byte> // Parasite nucleus. It may contain some debris. It shouldn't contain thrombocytes or larger elements.
+ parasite : Image<Gray, byte> // The whole parasites.
+ }
-let find (img: Image<Gray, float32>) (config: Config.Config) : Result * Image<Gray, float32> * Image<Gray, float32> =
+let find (img : Image<Gray, float32>) (config : Config.Config) : Result * Image<Gray, float32> * Image<Gray, float32> =
let imgWithoutNucleus = img.Copy()
areaCloseF imgWithoutNucleus (roundInt config.RBCRadius.NucleusArea)
otsu hist
imgWithoutNucleus.Cmp(float mean_fg - config.Parameters.darkStainLevel * float (mean_bg - mean_fg), CvEnum.CmpType.LessThan)
- let marker (img: Image<Gray, float32>) (closed: Image<Gray, float32>) (level: float) : Image<Gray, byte> =
+ let marker (img : Image<Gray, float32>) (closed : Image<Gray, float32>) (level : float) : Image<Gray, byte> =
let diff = img.Copy()
diff._Mul(level)
CvInvoke.Subtract(closed, diff, diff)
let size = roundInt config.RBCRadius.CytoplasmSize
if size % 2 = 0 then size + 1 else size
use kernel =
- if kernelSize <= 3
- then
+ if kernelSize <= 3 then
CvInvoke.GetStructuringElement(CvEnum.ElementShape.Rectangle, Size(3, 3), Point(-1, -1))
else
CvInvoke.GetStructuringElement(CvEnum.ElementShape.Ellipse, Size(kernelSize, kernelSize), Point(-1, -1))
CvInvoke.MorphologyEx(img, imgWithoutParasite, CvEnum.MorphOp.Close, kernel, Point(-1, -1), 1, CvEnum.BorderType.Replicate, MCvScalar())
let parasiteMarker = marker img imgWithoutParasite (1. / config.Parameters.cytoplasmSensitivity)
- { darkStain = darkStain
- nucleus = nucleusMarker
- parasite = parasiteMarker },
+ {
+ darkStain = darkStain
+ nucleus = nucleusMarker
+ parasite = parasiteMarker
+ },
imgWithoutParasite,
imgWithoutNucleus
type Points = HashSet<Point>
-type Ellipse (cx: float32, cy: float32, a: float32, b: float32, alpha: float32) =
+type Ellipse (cx : float32, cy : float32, a : float32, b : float32, alpha : float32) =
member this.Cx = cx
member this.Cy = cy
member this.A = a
member this.Contains x y =
((x - cx) * cos alpha + (y - cy) * sin alpha) ** 2.f / a ** 2.f + ((x - cx) * sin alpha - (y - cy) * cos alpha) ** 2.f / b ** 2.f <= 1.f
- member this.CutAVericalLine (y: float32) : bool =
+ member this.CutAVericalLine (y : float32) : bool =
a ** 2.f + b ** 2.f - 2.f * y ** 2.f + 4.f * y * cx - 2.f * cx ** 2.f + a ** 2.f * cos (2.f * alpha) - b ** 2.f * cos (2.f * alpha) > 0.f
- member this.CutAnHorizontalLine (x: float32) : bool =
+ member this.CutAnHorizontalLine (x : float32) : bool =
a ** 2.f + b ** 2.f - 2.f * x ** 2.f + 4.f * x * cy - 2.f * cy ** 2.f - a ** 2.f * cos (2.f * alpha) + b ** 2.f * cos (2.f * alpha) > 0.f
- member this.isOutside (width: float32) (height: float32) =
+ member this.isOutside (width : float32) (height : float32) =
this.Cx < 0.f || this.Cx >= width ||
this.Cy < 0.f || this.Cy >= height ||
this.CutAVericalLine 0.f || this.CutAVericalLine width ||
this.CutAnHorizontalLine 0.f || this.CutAnHorizontalLine height
- member this.Scale (factor: float32) : Ellipse =
+ member this.Scale (factor : float32) : Ellipse =
Ellipse(this.Cx, this.Cy, this.A * factor, this.B * factor, alpha)
// Approximation of Ramanujan.
PI * (3.f * (this.A + this.B) - sqrt ((3.f * this.A + this.B) * (this.A + 3.f * this.B)))
override this.ToString () =
- sprintf "(cx: %A, cy: %A, a: %A, b: %A, alpha: %A)" this.Cx this.Cy this.A this.B this.Alpha
+ sprintf "(cx: %f, cy: %f, a: %f, b: %f, alpha: %f)" this.Cx this.Cy this.A this.B this.Alpha
type CellClass = HealthyRBC | InfectedRBC | Peculiar
-type Cell = {
- cellClass: CellClass
- center: Point
- nucleusArea: int
- parasiteArea: int
- elements: Matrix<byte> }
+type Cell =
+ {
+ cellClass : CellClass
+ center : Point
+ nucleusArea : int
+ parasiteArea : int
+ elements : Matrix<byte>
+ }
[<Struct>]
-type Line (a: float32, b: float32) =
+type Line (a : float32, b : float32) =
member this.A = a
member this.B = b
finally
compensation()
- member this.Using (disposable: 'a when 'a :> IDisposable, body) =
+ member this.Using (disposable : 'a when 'a :> IDisposable, body) =
let body' = fun () -> body disposable
this.TryFinally(body', fun () ->
match disposable with
let μmPerInch = 25.4e3<μm/inch>
let mmPerInch = 25.4<mm/inch>
-let μmToInch(x: float<μm>) : float<inch> = x / μmPerInch
-let inchToμm(x: float<inch>) : float<μm> = x * μmPerInch
+let μmToInch(x : float<μm>) : float<inch> = x / μmPerInch
+let inchToμm(x : float<inch>) : float<μm> = x * μmPerInch
-let mmToInch(x: float<mm>) : float<inch> = x / mmPerInch
-let inchTomm(x: float<inch>) : float<mm> = x * mmPerInch
+let mmToInch(x : float<mm>) : float<inch> = x / mmPerInch
+let inchTomm(x : float<inch>) : float<mm> = x * mmPerInch
let inline dprintfn fmt =
Printf.ksprintf System.Diagnostics.Debug.WriteLine fmt
-let inline lineFromTwoPoints (p1: PointF) (p2: PointF) : 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) : PointF =
+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)
PointF(x, y)
-let inline linePassThroughSegment (l: Line) (p1: PointF) (p2: PointF) : 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: PointF) (p2: PointF) =
+let inline squaredDistanceTwoPoints (p1 : PointF) (p2 : PointF) =
(p1.X - p2.X) ** 2.f + (p1.Y - p2.Y) ** 2.f
-let inline distanceTwoPoints (p1: PointF) (p2: PointF) =
+let inline distanceTwoPoints (p1 : PointF) (p2 : PointF) =
squaredDistanceTwoPoints p1 p2 |> sqrt
-let countCells (cells: Cell list) : int * int =
- cells |> List.fold (fun (total, infected) { cellClass = cellClass } ->
- match cellClass with
- | HealthyRBC -> (total + 1, infected)
- | InfectedRBC -> (total + 1, infected + 1)
- | Peculiar -> (total, infected)) (0, 0)
\ No newline at end of file
+let countCells (cells : Cell list) : int * int =
+ cells
+ |> List.fold (
+ fun (total, infected) { cellClass = cellClass } ->
+ match cellClass with
+ | HealthyRBC -> (total + 1, infected)
+ | InfectedRBC -> (total + 1, infected + 1)
+ | Peculiar -> (total, infected)
+ ) (0, 0)
\ No newline at end of file
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="FSharp.Collections.ParallelSeq" version="1.0.2" targetFramework="net452" />
- <package id="FSharp.Core" version="4.0.0.1" targetFramework="net452" />
- <package id="MathNet.Numerics" version="3.10.0" targetFramework="net40" />
- <package id="MathNet.Numerics.FSharp" version="3.10.0" targetFramework="net40" />
+ <package id="FSharp.Core" version="4.1.0.2" targetFramework="net462" />
+ <package id="MathNet.Numerics" version="3.17.0" targetFramework="net462" />
+ <package id="MathNet.Numerics.FSharp" version="3.17.0" targetFramework="net462" />
+ <package id="System.ValueTuple" version="4.3.0" targetFramework="net462" />
</packages>
\ No newline at end of file
open System.Windows.Controls
open System.Diagnostics
-let showWindow (parent: Window) =
+let showWindow (parent : Window) =
let win = Views.AboutWindow()
- win.Root.Owner <- parent
+ win.Owner <- parent
- win.Root.Left <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Left) + parent.ActualWidth / 2. - win.Root.Width / 2.
- win.Root.Top <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Top) + parent.ActualHeight / 2. - win.Root.Height / 2.
+ win.Left <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Left) + parent.ActualWidth / 2. - win.Width / 2.
+ win.Top <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Top) + parent.ActualHeight / 2. - win.Height / 2.
let version = System.Reflection.Assembly.GetEntryAssembly().GetName().Version
let txtVersion = sprintf " %d.%d.%d" version.Major version.Minor version.Revision
win.txtAbout.Inlines.FirstInline.ElementEnd.InsertTextInRun(" - DEBUG")
#endif
- win.butClose.Click.AddHandler(fun obj args -> win.Root.Close())
+ win.butClose.Click.AddHandler(fun obj args -> win.Close())
- win.Root.ShowDialog() |> ignore
+ win.ShowDialog() |> ignore
open Types
-let showWindow (parent: Window) (state: State.State) : bool =
+let showWindow (parent : Window) (state : State.State) : bool =
let win = Views.AnalysisWindow()
- win.Root.Owner <- parent
- win.Root.Left <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Left) + parent.ActualWidth / 2. - win.Root.Width / 2.
- win.Root.Top <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Top) + parent.ActualHeight / 2. - win.Root.Height / 2.
+ win.Owner <- parent
+ win.Left <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Left) + parent.ActualWidth / 2. - win.Width / 2.
+ win.Top <- (if parent.WindowState = WindowState.Maximized then 0. else parent.Top) + parent.ActualHeight / 2. - win.Height / 2.
let logListener =
- { new Logger.IListener with
- member this.NewEntry severity mess =
- win.Root.Dispatcher.Invoke(fun () ->
- win.textLog.Inlines.Add(Documents.Run(mess))
- win.textLog.Inlines.Add(Documents.LineBreak())
- win.scrollLog.ScrollToBottom()) }
+ {
+ new Logger.IListener with
+ member this.NewEntry severity mess =
+ win.Dispatcher.Invoke(fun () ->
+ win.textLog.Inlines.Add(Documents.Run(mess))
+ win.textLog.Inlines.Add(Documents.LineBreak())
+ win.scrollLog.ScrollToBottom()
+ )
+ }
Logger.Log.AddListener(logListener)
let minPPI = 1.
let maxPPI = 10e6
- let parseAndValidatePPI (input: string) : float option =
+ let parseAndValidatePPI (input : string) : float option =
match Double.TryParse(input) with
| true, value when value >= minPPI && value <= maxPPI -> Some value
| _ -> None
imageSourceSelection.predefinedValuesMenu.Items.Add(menu) |> ignore
imageSourceSelection.butPPICalculator.Click.AddHandler(fun obj args ->
- match PPICalculator.showWindow win.Root with
+ match PPICalculator.showWindow win with
| Some resolution -> imageSourceSelection.txtResolution.Text <- resolution.ToString()
| None -> ())
// The boolean is 'true' if the image is selected (checked).
let getInputImagesParameters () : (SourceImage * bool * Parameters) list option =
let sourceImagesControls = win.stackSourceImagesSelection.Children |> Seq.cast<Views.ImageSourceSelection>
- let parameters = seq {
- for srcImgCtrl in sourceImagesControls do
- let srcImg = srcImgCtrl.Tag :?> SourceImage
- let isChecked = srcImgCtrl.chkSelection.IsChecked
- match parseAndValidatePPI srcImgCtrl.txtResolution.Text with
- | Some resolution ->
- yield Some (srcImg, isChecked.HasValue && isChecked.Value, { srcImg.config.Parameters with resolution = resolution * 1.<ppi> })
- | None ->
- MessageBox.Show(sprintf "No resolution defined for the image number %d" srcImg.num, "No resolution defined", MessageBoxButton.OK, MessageBoxImage.Information) |> ignore
- yield None } |> Seq.takeWhile (fun e -> e.IsSome) |> Seq.map (fun e -> e.Value) |> List.ofSeq
- if parameters.Count() <> sourceImagesControls.Count()
- then None
- else Some parameters
-
- win.butClose.Click.AddHandler(fun obj args -> win.Root.Close())
+ let parameters =
+ seq {
+ for srcImgCtrl in sourceImagesControls do
+ let srcImg = srcImgCtrl.Tag :?> SourceImage
+ let isChecked = srcImgCtrl.chkSelection.IsChecked
+ match parseAndValidatePPI srcImgCtrl.txtResolution.Text with
+ | Some resolution ->
+ yield Some (srcImg, isChecked.HasValue && isChecked.Value, { srcImg.config.Parameters with resolution = resolution * 1.<ppi> })
+ | None ->
+ MessageBox.Show(sprintf "No resolution defined for the image number %d" srcImg.num, "No resolution defined", MessageBoxButton.OK, MessageBoxImage.Information) |> ignore
+ yield None
+ } |> Seq.takeWhile (fun e -> e.IsSome) |> Seq.map (fun e -> e.Value) |> List.ofSeq
+
+ if parameters.Count() <> sourceImagesControls.Count() then
+ None
+ else
+ Some parameters
+
+ win.butClose.Click.AddHandler(fun obj args -> win.Close())
win.butStart.Click.AddHandler(fun obj args ->
match getInputImagesParameters () with
| Some imagesParameters ->
- let imagesToProcess = [
- for srcImg, selected, parameters in imagesParameters do
- srcImg.config.Parameters <- parameters // Save parameters.
- if selected
- then yield srcImg.num.ToString(), srcImg.config, srcImg.img ]
-
- if imagesToProcess.IsEmpty
- then
+ let imagesToProcess =
+ [
+ for srcImg, selected, parameters in imagesParameters do
+ srcImg.config.Parameters <- parameters // Save parameters.
+ if selected then
+ yield srcImg.num.ToString(), srcImg.config, srcImg.img
+ ]
+
+ if imagesToProcess.IsEmpty then
MessageBox.Show("No image selected", "Cannot start analysis", MessageBoxButton.OK, MessageBoxImage.Information) |> ignore
else
win.stackSourceImagesSelection.IsEnabled <- false
let maybeResults =
ParasitemiaCore.Analysis.doMultipleAnalysis
imagesToProcess
- (Some (fun progress -> win.Root.Dispatcher.Invoke(fun () -> win.progress.Value <- float progress); not analysisCancelled))
+ (Some (fun progress -> win.Dispatcher.Invoke(fun () -> win.progress.Value <- float progress); not analysisCancelled))
lock monitor (
fun() ->
| None ->
Logger.Log.User("Analysis aborted")
- win.Root.Dispatcher.Invoke(fun () ->
+ win.Dispatcher.Invoke(fun () ->
win.progress.Value <- if maybeResults.IsSome then 100. else 0.
win.stackSourceImagesSelection.IsEnabled <- true
win.butStart.IsEnabled <- true
win.butClose.Content <- "Close"
- updateSourceImages ()))
+ updateSourceImages ()
+ )
+ )
} |> Async.Start
- | _ -> ())
+ | _ -> ()
+ )
- win.Root.Loaded.AddHandler(fun obj args -> updateSourceImages ())
+ win.Loaded.AddHandler(fun obj args -> updateSourceImages ())
- win.Root.ShowDialog() |> ignore
+ win.ShowDialog() |> ignore
Logger.Log.RmListener(logListener)
- lock monitor (fun () ->
- if not analysisPerformed
- then
+ lock monitor (
+ fun () ->
+ if not analysisPerformed then
// To cancel the current analysis if one is running on the next call to the progress function.
analysisCancelled <- true
- atLeastOneAnalysisPerformed)
+ atLeastOneAnalysisPerformed
+ )
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<startup>
- <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.2" />
+ <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.2" />
</startup>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
// You can specify all the values or you can default the Build and Revision Numbers
// by using the '*' as shown below:
// [<assembly: AssemblyVersion("1.0.*")>]
-[<assembly: AssemblyVersion("1.0.0.7")>]
-[<assembly: AssemblyFileVersion("1.0.0.7")>]
+[<assembly: AssemblyVersion("1.0.0.8")>]
+[<assembly: AssemblyFileVersion("1.0.0.8")>]
do
()
\ No newline at end of file
open Types
-let showWindow (parent: Window) : int option =
+let showWindow (parent : Window) : int option =
let win = Views.PPICalculatorWindow()
- win.Root.Owner <- parent
- win.Root.Left <- parent.Left + parent.ActualWidth / 2. - win.Root.Width / 2.
- win.Root.Top <- parent.Top + parent.ActualHeight / 2. - win.Root.Height / 2.
+ win.Owner <- parent
+ win.Left <- parent.Left + parent.ActualWidth / 2. - win.Width / 2.
+ win.Top <- parent.Top + parent.ActualHeight / 2. - win.Height / 2.
for size in Utils.sensorSizes do
win.cmbSensorSize.Items.Add(size) |> ignore
win.cmbSensorSize.SelectedIndex <- 0
- let resolution (w_p: float<px>) (w_mm: float<mm>) (zoom: float) : float<ppi> =
+ let resolution (w_p : float<px>) (w_mm : float<mm>) (zoom : float) : float<ppi> =
w_p * zoom / mmToInch w_mm
let updateCurrentResolution () =
let parseDouble txt errorMess = match Double.TryParse(txt) with true, value -> Success value | _ -> Fail errorMess
- match result
- { let! sensorResolution = parseDouble win.txtSensorResolution.Text "The sensor resolution is not valid"
- let! zoom = parseDouble win.txtZoom.Text "The zoom is not valid"
- let wPixel = 1.<px> * sqrt (sensorResolution * 1e6 / ratio)
- return! Success (float <| resolution wPixel w zoom) } with
+ match
+ (result {
+ let! sensorResolution = parseDouble win.txtSensorResolution.Text "The sensor resolution is not valid"
+ let! zoom = parseDouble win.txtZoom.Text "The zoom is not valid"
+ let wPixel = 1.<px> * sqrt (sensorResolution * 1e6 / ratio)
+ return! Success (float <| resolution wPixel w zoom)
+ }) with
| Success res -> win.txtImageResolution.Text <- (int (res / 1000.) * 1000).ToString()
| Fail mess -> win.txtImageResolution.Text <- mess
- win.butCancel.Click.AddHandler(fun obj args -> win.Root.DialogResult <- Nullable<bool>(false); win.Root.Close())
- win.butOK.Click.AddHandler(fun obj args -> win.Root.DialogResult <- Nullable<bool>(true); win.Root.Close())
+ win.butCancel.Click.AddHandler(fun obj args -> win.DialogResult <- Nullable<bool>(false); win.Close())
+ win.butOK.Click.AddHandler(fun obj args -> win.DialogResult <- Nullable<bool>(true); win.Close())
win.cmbSensorSize.SelectionChanged.AddHandler(fun obj arg -> updateCurrentResolution ())
win.txtSensorResolution.TextChanged.AddHandler(fun obj arg -> updateCurrentResolution ())
win.txtZoom.TextChanged.AddHandler(fun obj arg -> updateCurrentResolution ())
- let result = win.Root.ShowDialog()
- if result.HasValue && result.Value
- then
+ let result = win.ShowDialog()
+ if result.HasValue && result.Value then
match Int32.TryParse win.txtImageResolution.Text with
| true, res -> Some res
| _ -> None
open State
/// <exception cref="System.IOException">If the results cannot be exported</exception>
-let exportResults (state: State) (filePath: string) =
+let exportResults (state : State) (filePath : string) =
use writer = new StreamWriter(new FileStream(filePath, FileMode.Create, FileAccess.Write))
fprintfn writer "File: %s" state.FilePath
- fprintfn writer "Export date: %A" DateTime.Now
+ fprintfn writer "Export date: %O" DateTime.Now
fprintfn writer ""
fprintfn writer "Patient ID: %s" state.PatientID
open ParasitemiaCore.Utils
open Types
-let run (defaultConfig: Config) (fileToOpen: string option) =
+let run (defaultConfig : Config) (fileToOpen : string option) =
let app = new Application()
let win = Views.MainWindow()
win.menuHightlightRBC.IsChecked <- displayHealthy
// Utils.
- let extractRBCPreview (img: Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte>) (rbc: RBC) : Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte> =
+ let extractRBCPreview (img : Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte>) (rbc : RBC) : Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte> =
let rbcWidth = rbc.size.Width
let rbcHeight = rbc.size.Height
let x = rbc.center.X - rbcWidth / 2. |> roundInt
System.Drawing.Size((if x + w >= img.Width then img.Width - x else w),
(if y + h >= img.Height then img.Height - y else h))))
- let setRBCFrameStyle (srcImg: SourceImage) (rbc: RBC) (frame: Views.RBCFrame) =
+ let setRBCFrameStyle (srcImg : SourceImage) (rbc : RBC) (frame : Views.RBCFrame) =
frame.Opacity <- if displayHealthy || rbc.setManually || rbc.infected then 1. else 0.
let color = if rbc.infected then srcImg.InfectedRBCColor else srcImg.HealthyRBCColor
frame.manuallyAdded.Visibility <- if rbc.setManually then Visibility.Visible else Visibility.Hidden
frame.manuallyAdded.Fill <- color
frame.border.Stroke <- color
- let RBCFrameFromExisting (srcImg: SourceImage) (rbc: RBC) (frame: Views.RBCFrame) : Views.RBCFrame =
+ let RBCFrameFromExisting (srcImg : SourceImage) (rbc : RBC) (frame : Views.RBCFrame) : Views.RBCFrame =
frame.Visibility <- Visibility.Visible
frame.Height <- rbc.size.Height
frame.Width <- rbc.size.Width
let statusMessageTimer = Threading.DispatcherTimer()
statusMessageTimer.Tick.AddHandler(fun obj args -> statusMessageTimer.Stop(); win.txtMessageStatus.Text <- "")
statusMessageTimer.Interval <- TimeSpan(0, 0, 2)
- let displayStatusMessage (message: string) =
+ let displayStatusMessage (message : string) =
win.txtMessageStatus.Text <- message
statusMessageTimer.Stop()
statusMessageTimer.Start()
- let highlightRBCFrame (frame: Views.RBCFrame) (highlight: bool) =
+ let highlightRBCFrame (frame : Views.RBCFrame) (highlight : bool) =
let rbc = frame.Tag :?> RBC
- if highlight
- then
+ if highlight then
frame.border.StrokeThickness <- 3.
if not rbc.infected && not rbc.setManually && not displayHealthy then frame.Opacity <- 1.
else
frame.border.StrokeThickness <- 1.
if not rbc.infected && not rbc.setManually && not displayHealthy then frame.Opacity <- 0.
- let zoomToRBC (rbc: RBC) =
+ let zoomToRBC (rbc : RBC) =
win.scrollViewCurrentImage.ScrollToHorizontalOffset(rbc.center.X * currentScale - win.scrollViewCurrentImage.ViewportWidth / 2. + win.borderCurrentImage.BorderThickness.Left)
win.scrollViewCurrentImage.ScrollToVerticalOffset(rbc.center.Y * currentScale - win.scrollViewCurrentImage.ViewportHeight / 2. + win.borderCurrentImage.BorderThickness.Top)
win.txtGlobalParasitemia.Inlines.Clear()
let total, infected = state.GlobalParasitemia
win.txtGlobalParasitemia.Inlines.Add(Documents.Run(Utils.percentText (total, infected), FontWeight = FontWeights.Bold))
- if total > 0 && total < warningBelowNumberOfRBC
- then
+ if total > 0 && total < warningBelowNumberOfRBC then
win.txtGlobalParasitemia.Inlines.Add(
Documents.Run(
sprintf " Warning: the number of erythrocytes should be above %d" warningBelowNumberOfRBC,
FontWeight = FontWeights.Bold,
- Foreground = Brushes.Red))
+ Foreground = Brushes.Red
+ )
+ )
let updateViewportPreview () =
for preview in win.stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> do
marginLeft,
marginTop,
marginRight,
- marginBottom)
+ marginBottom
+ )
else
preview.viewport.Visibility <- Visibility.Hidden
- let rec setAsInfected (srcImg: SourceImage) (rbc: RBC) (infected: bool) =
+ let rec setAsInfected (srcImg : SourceImage) (rbc : RBC) (infected : bool) =
state.SetAsInfected rbc infected
win.canvasCurrentImage.Children
|> Seq.cast<Views.RBCFrame>
- |> Seq.iter
- (fun frame ->
- if (frame.Tag :?> RBC) = rbc
- then
- setRBCFrameStyle srcImg rbc frame)
+ |> Seq.iter (
+ fun frame ->
+ if (frame.Tag :?> RBC) = rbc then
+ setRBCFrameStyle srcImg rbc frame
+ )
updateRBCFramesPreview ()
updateCurrentImageInformation ()
updateGlobalParasitemia ()
- and RBCFrame (srcImg: SourceImage) (rbc: RBC) : Views.RBCFrame =
+ and RBCFrame (srcImg : SourceImage) (rbc : RBC) : Views.RBCFrame =
let frame = RBCFrameFromExisting srcImg rbc (Views.RBCFrame())
frame.SetValue(Panel.ZIndexProperty, Int32.MaxValue - rbc.num) // To be sure the
frame.menuRBCSetAsHealthy.Click.AddHandler(fun obj args -> setAsInfected srcImg (frame.Tag :?> RBC) false)
frame.menuRBCSetAsInfected.Click.AddHandler(fun obj args -> setAsInfected srcImg (frame.Tag :?> RBC) true)
frame.ContextMenuOpening.AddHandler(
fun obj args ->
- if (frame.Tag :?> RBC).infected
- then
+ if (frame.Tag :?> RBC).infected then
frame.menuRBCSetAsHealthy.Visibility <- Visibility.Visible
frame.menuRBCSetAsInfected.Visibility <- Visibility.Collapsed
else
frame.menuRBCSetAsHealthy.Visibility <- Visibility.Collapsed
- frame.menuRBCSetAsInfected.Visibility <- Visibility.Visible)
-
+ frame.menuRBCSetAsInfected.Visibility <- Visibility.Visible
+ )
frame.ContextMenuClosing.AddHandler(fun obj args -> if not frame.IsMouseOver then highlightRBCFrame frame false )
frame.MouseEnter.AddHandler(fun obj args -> highlightRBCFrame frame true)
frame.MouseLeave.AddHandler(fun obj args -> if not frame.grid.ContextMenu.IsOpen then highlightRBCFrame frame false)
let mutable currentPreview = 0
for rbc in srcImg.rbcs |> List.filter (fun rbc -> displayHealthy || rbc.infected) do
let previewInfected =
- if currentPreview < win.stackRBC.Children.Count
- then
+ if currentPreview < win.stackRBC.Children.Count then
RBCFrameFromExisting srcImg rbc (win.stackRBC.Children.[currentPreview] :?> Views.RBCFrame)
else
let f = RBCFrame srcImg rbc
let mutable currentCanvas = 0
for rbc in srcImg.rbcs do
let frame =
- if currentCanvas < win.canvasCurrentImage.Children.Count
- then
+ if currentCanvas < win.canvasCurrentImage.Children.Count then
RBCFrameFromExisting srcImg rbc (win.canvasCurrentImage.Children.[currentCanvas] :?> Views.RBCFrame)
else
let f = RBCFrame srcImg rbc
- f.Root.Opacity <- 0.7
+ f.Opacity <- 0.7
win.canvasCurrentImage.Children.Add(f) |> ignore
f
let askDocumentPathToSave () : string option =
let dialog = SaveFileDialog(AddExtension = true, DefaultExt = PiaZ.extension, Filter = PiaZ.filter)
- if state.FilePath <> ""
- then
+ if state.FilePath <> "" then
dialog.FileName <- FileInfo(state.FilePath).Name
- elif state.PatientID <> ""
- then
+ elif state.PatientID <> "" then
dialog.FileName <- state.PatientID + PiaZ.extension
let res = dialog.ShowDialog()
let saveCurrentDocument () =
try
- if state.FilePath = ""
- then
+ if state.FilePath = "" then
match askDocumentPathToSave () with
| Some filepath ->
state.FilePath <- filepath
// Ask the use to save the current document if neccessary.
let askSaveCurrent () =
- if state.AlteredSinceLastSave
- then
+ if state.AlteredSinceLastSave then
match MessageBox.Show("Would you like to save the current document?", "Saving the current document", MessageBoxButton.YesNo, MessageBoxImage.Question) with
| MessageBoxResult.Yes -> saveCurrentDocument ()
| _ -> ()
updateCurrentImageInformation ()
- let setCurrentImage (srcImg: SourceImage) =
- if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg
- then
+ let setCurrentImage (srcImg : SourceImage) =
+ if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg then
state.CurrentImage <- Some srcImg
updateCurrentImage ()
- let addPreview (srcImg: SourceImage) =
+ let addPreview (srcImg : SourceImage) =
let imgCtrl = Views.ImageSourcePreview(Margin = Thickness(3.))
imgCtrl.menuRemoveImage.Click.AddHandler(fun obj args ->
let srcImg = imgCtrl.Tag :?> SourceImage
let currentRemoved = Some srcImg = state.CurrentImage
state.RemoveSourceImage srcImg
- if currentRemoved
- then
+ if currentRemoved then
updateCurrentImage()
updateGlobalParasitemia()
win.stackPreviews.Children.Add(imgCtrl) |> ignore
// Zoom to a mouse position into the control 'imgCtrl'.
- let zoomTo (mousePos: Point) =
+ let zoomTo (mousePos : Point) =
let canvasW = win.canvasCurrentImage.ActualWidth * currentScale
let canvasH = win.canvasCurrentImage.ActualHeight * currentScale
let centerX = (mousePos.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
setCurrentImage (state.SourceImages |> Seq.find (fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
imgCtrl.UpdateLayout()
zoomTo (args.GetPosition(imgCtrl))
- imgCtrl.CaptureMouse() |> ignore)
+ imgCtrl.CaptureMouse() |> ignore
+ )
imgCtrl.MouseMove.AddHandler(fun obj args ->
- if imgCtrl.IsMouseCaptured
- then
- zoomTo (args.GetPosition(imgCtrl)))
+ if imgCtrl.IsMouseCaptured then
+ zoomTo (args.GetPosition(imgCtrl))
+ )
imgCtrl.MouseLeftButtonUp.AddHandler(fun obj args ->
- if imgCtrl.IsMouseCaptured
- then
- imgCtrl.ReleaseMouseCapture())
+ if imgCtrl.IsMouseCaptured then
+ imgCtrl.ReleaseMouseCapture()
+ )
let updatePreviews () =
win.stackPreviews.Children.Clear ()
updateGlobalParasitemia ()
updateDocumentStatus ()
- let loadFile (filepath: string) =
+ let loadFile (filepath : string) =
askSaveCurrent ()
let previousFilePath = state.FilePath
try
let askLoadFile () =
let dialog = OpenFileDialog(Filter = PiaZ.filter)
let res = dialog.ShowDialog()
- if res.HasValue && res.Value
- then loadFile dialog.FileName
+ if res.HasValue && res.Value then
+ loadFile dialog.FileName
let newFile () =
askSaveCurrent ()
let extension = ".txt"
let dialog = SaveFileDialog(AddExtension = true, DefaultExt = extension)
- if state.FilePath <> ""
- then
+ if state.FilePath <> "" then
dialog.FileName <- Path.GetFileNameWithoutExtension(state.FilePath) + extension
- elif state.PatientID <> ""
- then
+ elif state.PatientID <> "" then
dialog.FileName <- state.PatientID + extension
let res = dialog.ShowDialog()
let importImage () =
let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
let res = dialog.ShowDialog()
- if res.HasValue && res.Value
- then
+ if res.HasValue && res.Value then
let noSourceImage = state.SourceImages.Count() = 0
for filename in dialog.FileNames do
updateGlobalParasitemia ()
- if noSourceImage
- then
+ if noSourceImage then
updateCurrentImage ()
win.txtPatient.TextChanged.AddHandler(fun obj args -> state.PatientID <- win.txtPatient.Text)
- win.menuExit.Click.AddHandler(fun obj args -> win.Root.Close())
+ win.menuExit.Click.AddHandler(fun obj args -> win.Close())
win.menuSave.Click.AddHandler(fun obj args -> saveCurrentDocument ())
win.menuSaveAs.Click.AddHandler(fun obj args -> saveCurrentDocumentAsNewFile ())
win.menuOpen.Click.AddHandler(fun obj args -> askLoadFile ())
win.menuAnalysis.SubmenuOpened.AddHandler(fun obj args -> win.menuStartAnalysis.IsEnabled <- state.SourceImages.Count() > 0)
win.menuStartAnalysis.Click.AddHandler(fun obj args ->
- if Analysis.showWindow win.Root state
- then
+ if Analysis.showWindow win state then
updateGlobalParasitemia ()
- updateCurrentImage ())
+ updateCurrentImage ()
+ )
win.menuHightlightRBC.Click.AddHandler(fun obj args ->
displayHealthy <- win.menuHightlightRBC.IsChecked
updateRBCFramesPreview ()
- updateRBCFramesCurrent ())
+ updateRBCFramesCurrent ()
+ )
- win.menuAbout.Click.AddHandler(fun obj args -> About.showWindow win.Root)
+ win.menuAbout.Click.AddHandler(fun obj args -> About.showWindow win)
- win.Root.Closing.AddHandler(fun obj args -> askSaveCurrent ())
+ win.Closing.AddHandler(fun obj args -> askSaveCurrent ())
// Zoom on the current image.
- let adjustCurrentImageBorders (deltaX: float) (deltaY: float) =
+ let adjustCurrentImageBorders (deltaX : float) (deltaY : float) =
win.borderCurrentImage.BorderThickness <-
Thickness(
(win.scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
(win.scrollViewCurrentImage.ViewportHeight + deltaY) / 2.,
(win.scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
- (win.scrollViewCurrentImage.ViewportHeight + deltaY) / 2.)
+ (win.scrollViewCurrentImage.ViewportHeight + deltaY) / 2.
+ )
win.canvasCurrentImage.SizeChanged.AddHandler(fun obj args ->
let deltaX = args.NewSize.Width - args.PreviousSize.Width
let deltaY = args.NewSize.Height - args.PreviousSize.Height
- if deltaX > 0.5 || deltaY > 0.5
- then
+ if deltaX > 0.5 || deltaY > 0.5 then
adjustCurrentImageBorders 0.0 0.0
// Center the view at the center of the image initialy.
win.scrollViewCurrentImage.UpdateLayout()
win.scrollViewCurrentImage.ScrollToHorizontalOffset(win.borderCurrentImage.ActualWidth / 2. - win.scrollViewCurrentImage.ViewportWidth / 2.)
- win.scrollViewCurrentImage.ScrollToVerticalOffset(win.borderCurrentImage.ActualHeight / 2. - win.scrollViewCurrentImage.ViewportHeight / 2.))
+ win.scrollViewCurrentImage.ScrollToVerticalOffset(win.borderCurrentImage.ActualHeight / 2. - win.scrollViewCurrentImage.ViewportHeight / 2.)
+ )
win.scrollViewCurrentImage.SizeChanged.AddHandler(fun obj args ->
let deltaX = args.NewSize.Width - args.PreviousSize.Width
let deltaY = args.NewSize.Height - args.PreviousSize.Height
adjustCurrentImageBorders deltaX deltaY
win.scrollViewCurrentImage.ScrollToHorizontalOffset(win.scrollViewCurrentImage.HorizontalOffset + deltaX / 8.)
- win.scrollViewCurrentImage.ScrollToVerticalOffset(win.scrollViewCurrentImage.VerticalOffset + deltaY / 8.))
+ win.scrollViewCurrentImage.ScrollToVerticalOffset(win.scrollViewCurrentImage.VerticalOffset + deltaY / 8.)
+ )
let mutable maxScale = 4.
let mutable minScale = 0.25
win.canvasCurrentImage.LayoutTransform <- currentImageScaleTransform
win.borderCurrentImage.PreviewMouseWheel.AddHandler(fun obj args ->
let scaleFactor = if args.Delta > 0 then 2.0 else 0.5
- if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale
- then
+ if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale then
let previousScale = currentScale
currentScale <-
let newScale = currentScale * scaleFactor
win.scrollViewCurrentImage.ScrollToHorizontalOffset(centerX * realScaleFactor - win.scrollViewCurrentImage.ViewportWidth / 2. + win.borderCurrentImage.BorderThickness.Left)
win.scrollViewCurrentImage.ScrollToVerticalOffset(centerY * realScaleFactor - win.scrollViewCurrentImage.ViewportHeight / 2. + win.borderCurrentImage.BorderThickness.Top)
- args.Handled <- true)
+ args.Handled <- true
+ )
// Pan on the current image.
let mutable scrollStartPosition = Point(0., 0.)
scrollStartOffsetY <- win.scrollViewCurrentImage.VerticalOffset
win.borderCurrentImage.Cursor <- Input.Cursors.ScrollAll
win.borderCurrentImage.CaptureMouse() |> ignore
- args.Handled <- true)
+ args.Handled <- true
+ )
win.borderCurrentImage.PreviewMouseMove.AddHandler(fun obj args ->
- if win.borderCurrentImage.IsMouseCaptured
- then
+ if win.borderCurrentImage.IsMouseCaptured then
let position = args.GetPosition(win.scrollViewCurrentImage)
let deltaX = scrollStartPosition.X - position.X
let deltaY = scrollStartPosition.Y - position.Y
win.scrollViewCurrentImage.ScrollToHorizontalOffset(deltaX + scrollStartOffsetX)
win.scrollViewCurrentImage.ScrollToVerticalOffset(deltaY + scrollStartOffsetY)
- args.Handled <- true)
+ args.Handled <- true
+ )
win.borderCurrentImage.PreviewMouseLeftButtonUp.AddHandler(fun obj args ->
- if win.borderCurrentImage.IsMouseCaptured
- then
+ if win.borderCurrentImage.IsMouseCaptured then
win.borderCurrentImage.Cursor <- Input.Cursors.Arrow
win.borderCurrentImage.ReleaseMouseCapture()
- args.Handled <- true)
+ args.Handled <- true
+ )
// Shortcuts.
// Save.
- win.Root.InputBindings.Add(
+ win.InputBindings.Add(
Input.KeyBinding(
- FSharp.ViewModule.FunCommand((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
- Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control))) |> ignore
+ ViewModule.FunCommand((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
+ Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control)
+ )
+ ) |> ignore
// Save as.
- win.Root.InputBindings.Add(
+ win.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
+ ViewModule.FunCommand((fun obj -> saveCurrentDocumentAsNewFile ()), (fun obj -> true)),
+ Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift)
+ )
+ ) |> ignore
// Open.
- win.Root.InputBindings.Add(
+ win.InputBindings.Add(
Input.KeyBinding(
- FSharp.ViewModule.FunCommand((fun obj -> askLoadFile ()), (fun obj -> true)),
- Input.KeyGesture(Input.Key.O, Input.ModifierKeys.Control))) |> ignore
+ ViewModule.FunCommand((fun obj -> askLoadFile ()), (fun obj -> true)),
+ Input.KeyGesture(Input.Key.O, Input.ModifierKeys.Control)
+ )
+ ) |> ignore
// New file.
- win.Root.InputBindings.Add(
+ win.InputBindings.Add(
Input.KeyBinding(
- FSharp.ViewModule.FunCommand((fun obj -> newFile ()), (fun obj -> true)),
- Input.KeyGesture(Input.Key.N, Input.ModifierKeys.Control))) |> ignore
+ ViewModule.FunCommand((fun obj -> newFile ()), (fun obj -> true)),
+ Input.KeyGesture(Input.Key.N, Input.ModifierKeys.Control)
+ )
+ ) |> ignore
// Export results.
- win.Root.InputBindings.Add(
+ win.InputBindings.Add(
Input.KeyBinding(
- FSharp.ViewModule.FunCommand((fun obj -> exportResults ()), (fun obj -> true)),
- Input.KeyGesture(Input.Key.E, Input.ModifierKeys.Control))) |> ignore
+ ViewModule.FunCommand((fun obj -> exportResults ()), (fun obj -> true)),
+ Input.KeyGesture(Input.Key.E, Input.ModifierKeys.Control)
+ )
+ ) |> ignore
// Import an image.
- win.Root.InputBindings.Add(
+ win.InputBindings.Add(
Input.KeyBinding(
- FSharp.ViewModule.FunCommand((fun obj -> importImage ()), (fun obj -> true)),
- Input.KeyGesture(Input.Key.A, Input.ModifierKeys.Control))) |> ignore
+ ViewModule.FunCommand((fun obj -> importImage ()), (fun obj -> true)),
+ Input.KeyGesture(Input.Key.A, Input.ModifierKeys.Control)
+ )
+ ) |> ignore
// Viewport preview.
win.scrollViewCurrentImage.ScrollChanged.AddHandler(fun obj args -> updateViewportPreview ())
updateDocumentStatus ()
win.gridImageInformation.Visibility <- Visibility.Hidden
- win.Root.Show()
+ win.Show()
match fileToOpen with
| Some filepath -> loadFile filepath
<OutputType>WinExe</OutputType>
<RootNamespace>ParasitemiaUI</RootNamespace>
<AssemblyName>ParasitemiaUI</AssemblyName>
- <TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
+ <TargetFrameworkVersion>v4.6.2</TargetFrameworkVersion>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
- <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
+ <TargetFSharpCoreVersion>4.4.1.0</TargetFSharpCoreVersion>
<Name>ParasitemiaUI</Name>
<NuGetPackageImportStamp>
</NuGetPackageImportStamp>
<Tailcalls>true</Tailcalls>
<OutputPath>bin\Release\</OutputPath>
<DefineConstants>TRACE</DefineConstants>
- <WarningLevel>3</WarningLevel>
+ <WarningLevel>1</WarningLevel>
<PlatformTarget>AnyCPU</PlatformTarget>
<DocumentationFile>bin\Release\ParasitemiaUI.XML</DocumentationFile>
<Prefer32Bit>false</Prefer32Bit>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
- <Reference Include="Emgu.CV">
- <HintPath>..\..\..\Emgu\emgucv-windows-universal 3.0.0.2157\bin\Emgu.CV.dll</HintPath>
- </Reference>
- <Reference Include="Emgu.Util">
- <HintPath>..\..\..\Emgu\emgucv-windows-universal 3.0.0.2157\bin\Emgu.Util.dll</HintPath>
+ <Reference Include="Emgu.CV.World">
+ <HintPath>..\..\..\Emgu\emgucv-windesktop 3.1.0.2282\bin\Emgu.CV.World.dll</HintPath>
</Reference>
- <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
+ <Reference Include="FSharp.Core, Version=4.4.1.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<HintPath>..\packages\FSharp.Core.4.0.0.1\lib\net40\FSharp.Core.dll</HintPath>
<Private>True</Private>
</Reference>
<Reference Include="FSharp.ViewModule">
- <HintPath>..\packages\FSharp.ViewModule.Core.0.9.9.2\lib\portable-net45+netcore45+wpa81+wp8+MonoAndroid1+MonoTouch1\FSharp.ViewModule.dll</HintPath>
- <Private>True</Private>
+ <HintPath>..\packages\FSharp.ViewModule.Core.1.0.7.0\lib\portable-net45+netcore45+wpa81+wp8+MonoAndroid1+MonoTouch1\FSharp.ViewModule.dll</HintPath>
</Reference>
<Reference Include="FsXaml.Wpf">
- <HintPath>..\packages\FsXaml.Wpf.0.9.9\lib\net45\FsXaml.Wpf.dll</HintPath>
- <Private>True</Private>
+ <HintPath>..\packages\FsXaml.Wpf.3.1.6\lib\net45\FsXaml.Wpf.dll</HintPath>
</Reference>
<Reference Include="FsXaml.Wpf.TypeProvider">
- <HintPath>..\packages\FsXaml.Wpf.0.9.9\lib\net45\FsXaml.Wpf.TypeProvider.dll</HintPath>
- <Private>True</Private>
+ <HintPath>..\packages\FsXaml.Wpf.3.1.6\lib\net45\FsXaml.Wpf.TypeProvider.dll</HintPath>
</Reference>
<Reference Include="mscorlib" />
<Reference Include="Newtonsoft.Json">
- <HintPath>..\packages\Newtonsoft.Json.8.0.2\lib\net45\Newtonsoft.Json.dll</HintPath>
- <Private>True</Private>
+ <HintPath>..\packages\Newtonsoft.Json.10.0.1\lib\net45\Newtonsoft.Json.dll</HintPath>
</Reference>
<Reference Include="PresentationCore" />
<Reference Include="PresentationFramework" />
<Reference Include="System.IO.Compression" />
<Reference Include="System.IO.Compression.FileSystem" />
<Reference Include="System.Numerics" />
+ <Reference Include="System.ValueTuple">
+ <HintPath>..\packages\System.ValueTuple.4.3.0\lib\netstandard1.0\System.ValueTuple.dll</HintPath>
+ </Reference>
<Reference Include="System.Windows.Interactivity">
<HintPath>..\packages\Expression.Blend.Sdk.1.0.2\lib\net45\System.Windows.Interactivity.dll</HintPath>
<Private>True</Private>
</ProjectReference>
</ItemGroup>
<PropertyGroup>
- <PostBuildEvent>xcopy "D:\Emgu\emgucv-windows-universal 3.0.0.2157\bin\x64" "$(TargetDir)x64" /Y /D /I
-xcopy "D:\Emgu\emgucv-windows-universal 3.0.0.2157\bin\x86" "$(TargetDir)x86" /Y /D /I</PostBuildEvent>
+ <PostBuildEvent>xcopy "D:\Emgu\emgucv-windesktop 3.1.0.2282\bin\x64" "$(TargetDir)x64" /Y /D /I
+xcopy "D:\Emgu\emgucv-windesktop 3.1.0.2282\bin\x86" "$(TargetDir)x86" /Y /D /I</PostBuildEvent>
</PropertyGroup>
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
let filter = "PIA|*.piaz"
// Information associated to a document.
-type JSONInformation = {
- patientID: string
- fileVersion: int }
+type JSONInformation =
+ {
+ patientID : string
+ fileVersion : int
+ }
// Information associated to each images.
-type JSONSourceImage = {
- num: int
- name: string
-
- RBCRadius: float32 // The RBC Radius found by granulometry.
- parameters: ParasitemiaCore.Config.Parameters
- dateLastAnalysis: DateTime
- rbcs: RBC List
-
- healthyRBCBrightness: float32 // 0 to 1.
- infectedRBCBrightness: float32 } // 0 to 1.
-
-type DocumentData = {
- patientID: string
- images: SourceImage list }
+type JSONSourceImage =
+ {
+ num : int
+ name : string
+
+ RBCRadius : float32 // The RBC Radius found by granulometry.
+ parameters : ParasitemiaCore.Config.Parameters
+ dateLastAnalysis : DateTime
+ rbcs : RBC List
+
+ healthyRBCBrightness : float32 // 0 to 1.
+ infectedRBCBrightness : float32 // 0 to 1.
+ }
+
+type DocumentData =
+ {
+ patientID : string
+ images : SourceImage list
+ }
let mainEntryName = "info.json"
let imageExtension = ".tiff"
/// <param name="filePath"></param>
/// <param name="data"></param>
/// <exception cref="System.IOException">If the file cannot be written</exception>
-let save (filePath: string) (data: DocumentData) =
+let save (filePath : string) (data : DocumentData) =
use file = ZipFile.Open(filePath, ZipArchiveMode.Update)
for e in List.ofSeq file.Entries do // 'ofSeq' to not iterate a collection currently modified.
use imgJSONFileWriter = new StreamWriter(imgJSONEntry.Open())
imgJSONFileWriter.Write(
JsonConvert.SerializeObject(
- { num = srcImg.num
- name = srcImg.name
- RBCRadius = srcImg.config.RBCRadius.Pixel
- parameters = srcImg.config.Parameters
- dateLastAnalysis = srcImg.dateLastAnalysis
- rbcs = srcImg.rbcs
- healthyRBCBrightness = srcImg.healthyRBCBrightness
- infectedRBCBrightness = srcImg.infectedRBCBrightness }))
-
-let updateDocumentData (fromVersion: int) (toVersion: int) (data: DocumentData) : DocumentData =
+ {
+ num = srcImg.num
+ name = srcImg.name
+ RBCRadius = srcImg.config.RBCRadius.Pixel
+ parameters = srcImg.config.Parameters
+ dateLastAnalysis = srcImg.dateLastAnalysis
+ rbcs = srcImg.rbcs
+ healthyRBCBrightness = srcImg.healthyRBCBrightness
+ infectedRBCBrightness = srcImg.infectedRBCBrightness
+ }
+ )
+ )
+
+let updateDocumentData (fromVersion : int) (toVersion : int) (data : DocumentData) : DocumentData =
for v in fromVersion + 1 .. toVersion do
match v with
| 1 -> // Version 0 -> 1 : set initial brightness for rbc.
/// </summary>
/// <param name="filePath"></param>
/// <exception cref="System.IOException">If the file cannot be read</exception>
-let load (filePath: string) (defaultConfig: ParasitemiaCore.Config.Config) : DocumentData =
+let load (filePath : string) (defaultConfig : ParasitemiaCore.Config.Config) : DocumentData =
use file = ZipFile.Open(filePath, ZipArchiveMode.Read)
let mainEntry = file.GetEntry(mainEntryName)
let info = JsonConvert.DeserializeObject<JSONInformation>(mainEntryReader.ReadToEnd())
updateDocumentData info.fileVersion currentFileVersion
- { patientID = info.patientID
- images = [ let mutable imgNum = 0
- for imgEntry in file.Entries do
- if imgEntry.Name.EndsWith(imageExtension)
- then
+ {
+ patientID = info.patientID
+ images =
+ [
+ let mutable imgNum = 0
+ for imgEntry in file.Entries do
+ if imgEntry.Name.EndsWith(imageExtension) then
use bitmap = new System.Drawing.Bitmap(imgEntry.Open(), false)
let img = new Image<Bgr, byte>(bitmap)
imgNum <- imgNum + 1
let config = defaultConfig.Copy()
config.Parameters <-
- { ParasitemiaCore.Config.defaultParameters with
- resolution = imgInfo.parameters.resolution }
+ {
+ ParasitemiaCore.Config.defaultParameters with
+ resolution = imgInfo.parameters.resolution
+ }
config.SetRBCRadius imgInfo.RBCRadius
- yield { num = imgNum
+ yield
+ {
+ num = imgNum
name = imgInfo.name
config = config
dateLastAnalysis = imgInfo.dateLastAnalysis
img = img
rbcs = imgInfo.rbcs
healthyRBCBrightness = imgInfo.healthyRBCBrightness
- infectedRBCBrightness = imgInfo.infectedRBCBrightness } ] }
\ No newline at end of file
+ infectedRBCBrightness = imgInfo.infectedRBCBrightness
+ }
+ ]
+ }
\ No newline at end of file
type Arguments = RunningMode * bool
-let parseArgs (args: string[]) : Arguments =
+let parseArgs (args : string[]) : Arguments =
let output = Array.tryFindIndex ((=) "--output") args
printfn " --folder <folder> : an input folder containing images to analyze"
printfn " --file <file> : an image file to be analyzed"
printfn " --output <folder> : a folder to put the results"
- printfn " --debug: output more information like intermediate images if set"
+ printfn " --debug : output more information like intermediate images if set"
printfn "Interactive mode:"
printfn " %s [<document-file>] [--debug]" System.AppDomain.CurrentDomain.FriendlyName
// To redirect stdout to the attached console.
AttachConsole(-1) |> ignore // -1 to attach to the parent process.
- if Array.exists (fun e -> e = "--help" || e = "-h") args
- then
+ if Array.exists (fun e -> e = "--help" || e = "-h") args then
showArgsHelp ()
0
else
match mode with
| CmdLine (input, output) ->
- if debug
- then
+ if debug then
config.Debug <- DebugOn output
Directory.CreateDirectory output |> ignore
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 : %O %s ===" DateTime.Now (if debug then "[DEBUG]" else "[RELEASE]"))
let files = match input with
| File file -> [ file ]
let config, img = images |> List.pick (fun (id', config', img') -> if id' = id then Some (config', img') else None)
img.Dispose()
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
+ fprintf resultFile "File: %s %d %d %.2f (diameter: %O)\n" id total infected (100. * (float infected) / (float total)) config.RBCRadius
| None ->
fprintf resultFile "Analysis aborted"
Some ())) |> ignore
open Types
-type State (defaultConfig: ParasitemiaCore.Config.Config) =
+type State (defaultConfig : ParasitemiaCore.Config.Config) =
let sourceImages = List<SourceImage>()
let mutable alteredSinceLastSave = false
let mutable patientID = ""
member this.AlteredSinceLastSave = alteredSinceLastSave
- member val CurrentImage: SourceImage option = None with get, set
- member val FilePath: string = "" with get, set
+ member val CurrentImage : SourceImage option = None with get, set
+ member val FilePath : string = "" with get, set
member this.PatientID
with get () : string = patientID
and set id =
- if id <> patientID
- then
+ if id <> patientID then
alteredSinceLastSave <- true
patientID <- id
- member this.ImageParasitemia (srcImg: SourceImage) : int * int =
+ member this.ImageParasitemia (srcImg : SourceImage) : int * int =
List.length srcImg.rbcs,
srcImg.rbcs |> List.fold (fun nbInfected rbc -> if rbc.infected then nbInfected + 1 else nbInfected) 0
- member this.ImageNbManuallyChangedRBC (srcImg: SourceImage) (setAsInfected: bool) : int * int =
+ member this.ImageNbManuallyChangedRBC (srcImg : SourceImage) (setAsInfected : bool) : int * int =
List.length srcImg.rbcs,
srcImg.rbcs |> List.fold (fun nb rbc -> if rbc.setManually && rbc.infected = setAsInfected then nb + 1 else nb) 0
- member this.ImageNbManuallyChangedRBCStr (srcImg: SourceImage) (setAsInfected: bool) : string =
+ member this.ImageNbManuallyChangedRBCStr (srcImg : SourceImage) (setAsInfected : bool) : string =
Utils.percentText (this.ImageNbManuallyChangedRBC srcImg setAsInfected)
- member this.ImageManuallyChangedRBC (srcImg: SourceImage) (setAsInfected: bool) : int seq =
+ member this.ImageManuallyChangedRBC (srcImg : SourceImage) (setAsInfected : bool) : int seq =
query {
for rbc in srcImg.rbcs do
where (rbc.setManually && rbc.infected = setAsInfected)
- select rbc.num }
+ select rbc.num
+ }
- member this.ImageManuallyChangedRBCStr (srcImg: SourceImage) (setAsInfected: bool) : string =
+ member this.ImageManuallyChangedRBCStr (srcImg : SourceImage) (setAsInfected : bool) : string =
let listStr = Utils.listAsStr <| this.ImageManuallyChangedRBC srcImg setAsInfected
- if listStr = ""
- then ""
- else "[" + listStr + "]"
+ if listStr = "" then
+ ""
+ else
+ "[" + listStr + "]"
member this.GlobalParasitemia : int * int =
sourceImages
- |> Seq.fold (fun (nbTotal, nbTotalInfected) srcImg ->
- let nb, nbInfected = this.ImageParasitemia srcImg
- nbTotal + nb, nbTotalInfected + nbInfected) (0, 0)
-
-
- member this.SetAsInfected (rbc: RBC) (infected: bool) =
- if infected <> rbc.infected
- then
+ |> Seq.fold (
+ fun (nbTotal, nbTotalInfected) srcImg ->
+ let nb, nbInfected = this.ImageParasitemia srcImg
+ nbTotal + nb, nbTotalInfected + nbInfected
+ ) (0, 0)
+
+ member this.SetAsInfected (rbc : RBC) (infected : bool) =
+ if infected <> rbc.infected then
alteredSinceLastSave <- true
rbc.infected <- infected
rbc.setManually <- not rbc.setManually
/// <summary>
/// </summary>
/// <exception cref="System.IOException">If the image cannot be read</exception>
- member this.AddSourceImage (filePath: string) (defaultConfig: ParasitemiaCore.Config.Config) : SourceImage =
+ member this.AddSourceImage (filePath : string) (defaultConfig : ParasitemiaCore.Config.Config) : SourceImage =
let srcImg =
- { num = sourceImages.Count + 1
- name = System.IO.FileInfo(filePath).Name
- config = defaultConfig.Copy()
- dateLastAnalysis = DateTime(0L)
- rbcs = []
- img = new Image<Bgr, byte>(filePath)
- healthyRBCBrightness = 1.f
- infectedRBCBrightness = 1.f }
+ {
+ num = sourceImages.Count + 1
+ name = System.IO.FileInfo(filePath).Name
+ config = defaultConfig.Copy()
+ dateLastAnalysis = DateTime(0L)
+ rbcs = []
+ img = new Image<Bgr, byte>(filePath)
+ healthyRBCBrightness = 1.f
+ infectedRBCBrightness = 1.f
+ }
sourceImages.Add(srcImg)
- if sourceImages.Count = 1
- then this.CurrentImage <- Some sourceImages.[0]
+ if sourceImages.Count = 1 then
+ this.CurrentImage <- Some sourceImages.[0]
alteredSinceLastSave <- true
srcImg
- member this.RemoveSourceImage (srcImg: SourceImage) =
+ member this.RemoveSourceImage (srcImg : SourceImage) =
let isCurrent =
match this.CurrentImage with
| Some srcImg' -> srcImg = srcImg'
| _ -> false
- if sourceImages.Remove(srcImg)
- then
+ if sourceImages.Remove(srcImg) then
alteredSinceLastSave <- true
- if isCurrent
- then
+ if isCurrent then
this.CurrentImage <- if sourceImages.Count > 0 then Some sourceImages.[0] else None
// Re-numbered the images.
sourceImages |> Seq.iteri (fun i srcImg -> srcImg.num <- i + 1)
- member this.SetName (srcImg: SourceImage) (name: string) =
- if name <> srcImg.name
- then
+ member this.SetName (srcImg : SourceImage) (name : string) =
+ if name <> srcImg.name then
srcImg.name <- name
alteredSinceLastSave <- true
- member this.SetResult (imgNum: int) (cells: ParasitemiaCore.Types.Cell list) =
+ member this.SetResult (imgNum : int) (cells : ParasitemiaCore.Types.Cell list) =
let sourceImage = sourceImages.Find(fun srcImg -> srcImg.num = imgNum)
let w = sourceImage.img.Width
// To match with previously manually altered RBC.
let manuallyAlteredPreviousRBCS = sourceImage.rbcs |> List.filter (fun rbc -> rbc.setManually)
let tolerance = (float sourceImage.config.RBCRadius.Pixel) * 0.5 // +/-.
- let getPreviousManuallyAlteredRBC (center: Point) : RBC option =
+ let getPreviousManuallyAlteredRBC (center : Point) : RBC option =
manuallyAlteredPreviousRBCS |> List.tryFind (fun rbc -> rbc.center.X > center.X - tolerance && rbc.center.X < center.X + tolerance &&
rbc.center.Y > center.Y - tolerance && rbc.center.Y < center.Y + tolerance)
- sourceImage.rbcs <- cells
+ sourceImage.rbcs <-
+ cells
|> List.filter (fun cell -> match cell.cellClass with ParasitemiaCore.Types.HealthyRBC | ParasitemiaCore.Types.InfectedRBC -> true | _ -> false )
|> List.sortByDescending (fun cell -> cell.nucleusArea, (w - cell.center.X) + (h - cell.center.Y))
- |> List.mapi (fun i cell ->
- let center = Point(float cell.center.X, float cell.center.Y)
- let infected, setManually =
- let infected = cell.cellClass = ParasitemiaCore.Types.InfectedRBC
- match getPreviousManuallyAlteredRBC center with
- | Some rbc when rbc.infected <> infected -> rbc.infected, true // If it has been previously manually changed and now match the result, the manually flag is removed.
- | _ -> infected, false
-
- { num = i + 1
- infected = infected
- setManually = setManually
- center = center
- size = Size(float cell.elements.Width, float cell.elements.Height)
- infectedArea = cell.nucleusArea })
+ |> List.mapi (
+ fun i cell ->
+ let center = Point(float cell.center.X, float cell.center.Y)
+ let infected, setManually =
+ let infected = cell.cellClass = ParasitemiaCore.Types.InfectedRBC
+ match getPreviousManuallyAlteredRBC center with
+ | Some rbc when rbc.infected <> infected -> rbc.infected, true // If it has been previously manually changed and now match the result, the manually flag is removed.
+ | _ -> infected, false
+ {
+ num = i + 1
+ infected = infected
+ setManually = setManually
+ center = center
+ size = Size(float cell.elements.Width, float cell.elements.Height)
+ infectedArea = cell.nucleusArea
+ }
+ )
alteredSinceLastSave <- true
let healthyRBColor = Color.FromRgb(255uy, 255uy, 0uy) // Yellow-green.
let infectedRBColor = Color.FromRgb(255uy, 0uy, 40uy) // Red with a bit of blue.
-type RBC = {
- num: int
-
- [<JsonIgnore>]
- mutable infected: bool
-
- [<JsonIgnore>]
- mutable setManually: bool
-
- center: Point
- size: Size
- infectedArea: int }
-
-type SourceImage = {
- mutable num: int
- mutable name: string
-
- mutable config: ParasitemiaCore.Config.Config
- mutable dateLastAnalysis: DateTime // UTC.
- img: Image<Bgr, byte>
- mutable rbcs: RBC list
-
- mutable healthyRBCBrightness: float32
- mutable infectedRBCBrightness: float32 } with
-
- member this.HealthyRBCColor: SolidColorBrush =
- let mutable color = healthyRBColor * this.healthyRBCBrightness
- color.A <- 255uy;
- SolidColorBrush(color)
-
- member this.InfectedRBCColor: SolidColorBrush =
- let mutable color = infectedRBColor * this.infectedRBCBrightness
- color.A <- 255uy;
- SolidColorBrush(color)
-
-type PredefinedPPI = {
- ppi: int<ppi>
- label: string } with
- override this.ToString() =
- sprintf "%s: %d" this.label this.ppi
-
-type SensorSize = {
- w: float<mm>
- h: float<mm>
- label: string } with
- override this.ToString () =
- sprintf "%g mm × %g mm%s" this.w this.h (if this.label = "" then "" else " (" + this.label + ")")
-
-let defaultPredefinedPPI = [
- { ppi = 230000<ppi>; label = "50×" }
- { ppi = 460000<ppi>; label = "100×" } ]
-
-let defaultSensorSizes = [
- { w = 3.2<mm>; h = 2.4<mm>; label = "1/4″" }
- { w = 4.8<mm>; h = 3.6<mm>; label = "1/3″" }
- { w = 5.76<mm>; h = 4.29<mm>; label = "1/2.5″" }
- { w = 6.4<mm>; h = 4.8<mm>; label = "1/2″" }
- { w = 7.18<mm>; h = 5.32<mm>; label = "1/1.8″" }
- { w = 7.6<mm>; h = 5.7<mm>; label = "1/1.7″" }
- { w = 8.8<mm>; h = 6.6<mm>; label = "2/3″" }
- { w = 13.2<mm>; h = 8.8<mm>; label = "1″" } ]
+type RBC =
+ {
+ num : int
+
+ [<JsonIgnore>]
+ mutable infected : bool
+
+ [<JsonIgnore>]
+ mutable setManually : bool
+
+ center : Point
+ size : Size
+ infectedArea : int
+ }
+
+type SourceImage =
+ {
+ mutable num : int
+ mutable name : string
+
+ mutable config : ParasitemiaCore.Config.Config
+ mutable dateLastAnalysis : DateTime // UTC.
+ img : Image<Bgr, byte>
+ mutable rbcs : RBC list
+
+ mutable healthyRBCBrightness : float32
+ mutable infectedRBCBrightness : float32
+ }
+ with
+ member this.HealthyRBCColor : SolidColorBrush =
+ let mutable color = healthyRBColor * this.healthyRBCBrightness
+ color.A <- 255uy
+ SolidColorBrush(color)
+
+ member this.InfectedRBCColor : SolidColorBrush =
+ let mutable color = infectedRBColor * this.infectedRBCBrightness
+ color.A <- 255uy
+ SolidColorBrush(color)
+
+type PredefinedPPI =
+ {
+ ppi : int<ppi>
+ label : string
+ }
+ with
+ override this.ToString() =
+ sprintf "%s: %d" this.label this.ppi
+
+type SensorSize =
+ {
+ w : float<mm>
+ h : float<mm>
+ label : string
+ }
+ with
+ override this.ToString () =
+ sprintf "%g mm × %g mm%s" this.w this.h (if this.label = "" then "" else " (" + this.label + ")")
+
+let defaultPredefinedPPI =
+ [
+ { ppi = 230000<ppi>; label = "50×" }
+ { ppi = 460000<ppi>; label = "100×" }
+ ]
+
+let defaultSensorSizes =
+ [
+ { w = 3.2<mm>; h = 2.4<mm>; label = "1/4″" }
+ { w = 4.8<mm>; h = 3.6<mm>; label = "1/3″" }
+ { w = 5.76<mm>; h = 4.29<mm>; label = "1/2.5″" }
+ { w = 6.4<mm>; h = 4.8<mm>; label = "1/2″" }
+ { w = 7.18<mm>; h = 5.32<mm>; label = "1/1.8″" }
+ { w = 7.6<mm>; h = 5.7<mm>; label = "1/1.7″" }
+ { w = 8.8<mm>; h = 6.6<mm>; label = "2/3″" }
+ { w = 13.2<mm>; h = 8.8<mm>; label = "1″" }
+ ]
open Types
-let listAsStr (s: 'a seq) =
+let listAsStr (s : 'a seq) =
s |> Seq.fold (fun acc obj -> acc + (if acc = "" then "" else ", ") + obj.ToString()) ""
-let percentText (nbTotal: int, nb: int) : string =
- if nbTotal = 0
- then
+let percentText (nbTotal : int, nb : int) : string =
+ if nbTotal = 0 then
""
else
let percent = 100. * (float nb) / (float nbTotal)
let sensorSizesFilename = "sensor-sizes.json"
let sensorSizesFilepath = Path.Combine(roamingDir, sensorSizesFilename)
-let private savePredefinedPPIToFile (predefinedPPI: PredefinedPPI list) =
+let private savePredefinedPPIToFile (predefinedPPI : PredefinedPPI list) =
try
use file = new StreamWriter(predefinedPPIFilepath)
file.Write(JsonConvert.SerializeObject(predefinedPPI, JsonSerializerSettings(Formatting = Formatting.Indented)))
ex ->
Logger.Log.Error("Unable to save predefined PPI to file \"{0}\": {1}", predefinedPPIFilepath, ex)
-let private saveSensorSizesToFile (sensorSizes: SensorSize list) =
+let private saveSensorSizesToFile (sensorSizes : SensorSize list) =
try
use file = new StreamWriter(sensorSizesFilepath)
file.Write(JsonConvert.SerializeObject(sensorSizes, JsonSerializerSettings(Formatting = Formatting.Indented)))
open FsXaml
-type AboutWindow = XAML<"XAML/AboutWindow.xaml", true>
+type AboutWindow = XAML<"XAML/AboutWindow.xaml">
open FsXaml
-type AnalysisWindow = XAML<"XAML/AnalysisWindow.xaml", true>
+type AnalysisWindow = XAML<"XAML/AnalysisWindow.xaml">
open System.Windows.Data
open System.Windows.Input
-open FSharp.ViewModule
+open ViewModule.FSharp
open FsXaml
-type ImageSourcePreview = XAML<"XAML/ImageSourcePreview.xaml", true>
-
-(* type ImageSourcePreviewController() =
- inherit UserControlViewController<ImageSourcePreview>() *)
-
-(* type ImageSourcePreviewViewModel() =
- inherit ViewModelBase() *)
+type ImageSourcePreview = XAML<"XAML/ImageSourcePreview.xaml">
open System.Windows.Data
open System.Windows.Input
-open FSharp.ViewModule
+open ViewModule.FSharp
open FsXaml
-type ImageSourceSelection = XAML<"XAML/ImageSourceSelection.xaml", true>
-
-(* type ImageSourcePreviewController() =
- inherit UserControlViewController<ImageSourcePreview>() *)
-
-(* type ImageSourcePreviewViewModel() =
- inherit ViewModelBase() *)
+type ImageSourceSelection = XAML<"XAML/ImageSourceSelection.xaml">
open FsXaml
-type MainWindow = XAML<"XAML/MainWindow.xaml", true>
+type MainWindow = XAML<"XAML/MainWindow.xaml">
open FsXaml
-type PPICalculatorWindow = XAML<"XAML/PPICalculatorWindow.xaml", true>
+type PPICalculatorWindow = XAML<"XAML/PPICalculatorWindow.xaml">
open System.Windows.Data
open System.Windows.Input
-open FSharp.ViewModule
+open ViewModule.FSharp
open FsXaml
-type RBCFrame = XAML<"XAML/RBCFrame.xaml", true>
+type RBCFrame = XAML<"XAML/RBCFrame.xaml">
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="Expression.Blend.Sdk" version="1.0.2" targetFramework="net46" />
- <package id="FSharp.Core" version="4.0.0.1" targetFramework="net461" />
- <package id="FSharp.ViewModule.Core" version="0.9.9.2" targetFramework="net461" />
- <package id="FsXaml.Wpf" version="0.9.9" targetFramework="net46" />
- <package id="Newtonsoft.Json" version="8.0.2" targetFramework="net452" />
+ <package id="FSharp.Core" version="4.1.0.2" targetFramework="net462" />
+ <package id="FSharp.ViewModule.Core" version="1.0.7.0" targetFramework="net462" />
+ <package id="FsXaml.Wpf" version="3.1.6" targetFramework="net462" />
+ <package id="Newtonsoft.Json" version="10.0.1" targetFramework="net462" />
+ <package id="System.ValueTuple" version="4.3.0" targetFramework="net462" />
</packages>
\ No newline at end of file
<PlatformTarget>AnyCPU</PlatformTarget>
</PropertyGroup>
<ItemGroup>
- <Reference Include="Emgu.CV">
- <HintPath>..\..\..\Emgu\emgucv-windows-universal 3.0.0.2157\bin\Emgu.CV.dll</HintPath>
- </Reference>
- <Reference Include="Emgu.Util">
- <HintPath>..\..\..\Emgu\emgucv-windows-universal 3.0.0.2157\bin\Emgu.Util.dll</HintPath>
+ <Reference Include="Emgu.CV.World">
+ <HintPath>..\..\..\Emgu\emgucv-windesktop 3.1.0.2282\bin\Emgu.CV.World.dll</HintPath>
</Reference>
<Reference Include="PresentationCore" />
<Reference Include="PresentationFramework" />