--- /dev/null
+namespace Logger.AssemblyInfo
+
+open System.Reflection
+open System.Runtime.CompilerServices
+open System.Runtime.InteropServices
+
+// General Information about an assembly is controlled through the following
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+[<assembly: AssemblyTitle("Logger")>]
+[<assembly: AssemblyDescription("")>]
+[<assembly: AssemblyConfiguration("")>]
+[<assembly: AssemblyCompany("")>]
+[<assembly: AssemblyProduct("Logger")>]
+[<assembly: AssemblyCopyright("Copyright © 2016")>]
+[<assembly: AssemblyTrademark("")>]
+[<assembly: AssemblyCulture("")>]
+
+// Setting ComVisible to false makes the types in this assembly not visible
+// to COM components. If you need to access a type in this assembly from
+// COM, set the ComVisible attribute to true on that type.
+[<assembly: ComVisible(false)>]
+
+// The following GUID is for the ID of the typelib if this project is exposed to COM
+[<assembly: Guid("a4f183ae-562a-4bad-88e6-658b4ce15dc3")>]
+
+// Version information for an assembly consists of the following four values:
+//
+// Major Version
+// Minor Version
+// Build Number
+// Revision
+//
+// 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.0")>]
+[<assembly: AssemblyFileVersion("1.0.0.0")>]
+
+do
+ ()
\ No newline at end of file
--- /dev/null
+namespace Logger
+
+open System
+open System.Text
+open System.IO
+open System.Diagnostics
+open System.Threading
+open System.Collections.Generic
+
+type Severity = DEBUG = 1 | USER = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5
+
+type IListener = abstract NewEntry : Severity -> string -> unit
+
+[<Sealed>]
+type Log () =
+ let maxSizeFile = 10L * 1024L * 1024L // [byte] (10 MB).
+ let nbEntriesCheckSize = 100; // Each 100 entries added we check the size of the log file to test if it is greater than 'MAX_SIZE_FILE'.
+ let LogDefaultDirectory = "Parasitemia\\Log"
+ let filenameFormat = "{0:D4}.log"
+ let encoding = Encoding.GetEncoding("UTF-8")
+
+ let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name
+
+ let mutable stream: StreamWriter = null
+
+ let mutable logDir: string = null
+ let mutable absoluteDir: string = null
+
+ let mutable nbEntries = 0L
+
+ let monitor = Object()
+
+ let listeners = List<IListener>()
+
+ let debug =
+#if DEBUG
+ true
+#else
+ false
+#endif
+
+ static let instance = new Log()
+
+ let setLogDirectory (dir: string) =
+ lock monitor (fun () ->
+ logDir <- dir
+ absoluteDir <- Path.Combine(System.Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), logDir)
+
+ if stream <> null
+ then
+ stream.Close()
+ stream <- null
+
+ try
+ 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
+ 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
+ n <- !current_n
+
+ let mutable filename = Path.Combine(absoluteDir, String.Format(filenameFormat, n))
+ try
+ if (FileInfo(filename).Length > maxSizeFile)
+ then
+ filename <- Path.Combine(absoluteDir, String.Format(filenameFormat, n + 1))
+ with
+ | :? FileNotFoundException -> () // The file may not exist.
+
+ stream <- new StreamWriter(filename, true, encoding)
+ with
+ | _ as ex -> Console.Error.WriteLine("Can't open the file log: {0}", ex)
+
+ do
+ setLogDirectory LogDefaultDirectory
+
+ interface IDisposable with
+ member this.Dispose () =
+ if stream <> null
+ then
+ stream.Dispose()
+
+ member private this.Write (message: string, severity: Severity) =
+ lock monitor (fun () ->
+ nbEntries <- nbEntries + 1L
+ openLogFile ()
+
+ 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
+ | Some name -> moduleNameCaller <- name
+ | _ -> ()
+
+ let threadName = Thread.CurrentThread.Name
+
+ for listener in listeners do
+ listener.NewEntry severity message
+
+ try
+ stream.WriteLine(
+ "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3}) : {4}",
+ TimeZone.CurrentTimeZone.ToLocalTime(DateTime.UtcNow),
+ severity.ToString(),
+ moduleNameCaller,
+ (if String.IsNullOrEmpty(threadName) then Thread.CurrentThread.ManagedThreadId.ToString() else String.Format("{0}-{1}", threadName, Thread.CurrentThread.ManagedThreadId)),
+ message
+ )
+ stream.Flush()
+ with
+ | :? IOException as ex -> Console.Error.WriteLine("Unable to write to the log file: {0}", ex))
+
+
+ member private this.AddListener (listener: IListener) =
+ lock monitor (fun () ->
+ if not <| listeners.Contains(listener)
+ then
+ listeners.Add(listener))
+
+ 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 LogWithTime (message: string, severity: Severity, f: unit -> 'a, [<ParamArray>] args: Object[]) : 'a =
+ let sw = Stopwatch()
+ sw.Start()
+ let res = f ()
+ sw.Stop()
+ instance.Write(String.Format(message, args) + sprintf " (time: %d ms)" sw.ElapsedMilliseconds, severity)
+ res
+
+ 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[]) =
+ instance.Write(String.Format(message, args), Severity.USER)
+
+ static member Warning (message: string, [<ParamArray>] args: Object[]) =
+ instance.Write(String.Format(message, args), Severity.WARNING)
+
+ static member Error (message: string, [<ParamArray>] args: Object[]) =
+ instance.Write(String.Format(message, args), Severity.ERROR)
+
+ static member Fatal (message: string, [<ParamArray>] args: Object[]) =
+ instance.Write(String.Format(message, args), Severity.FATAL)
+
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>a4f183ae-562a-4bad-88e6-658b4ce15dc3</ProjectGuid>
+ <OutputType>Library</OutputType>
+ <RootNamespace>Logger</RootNamespace>
+ <AssemblyName>Logger</AssemblyName>
+ <TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
+ <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
+ <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
+ <Name>Logger</Name>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <DocumentationFile>bin\Debug\Logger.XML</DocumentationFile>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <Tailcalls>true</Tailcalls>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <DocumentationFile>bin\Release\Logger.XML</DocumentationFile>
+ </PropertyGroup>
+ <ItemGroup>
+ <Reference Include="mscorlib" />
+ <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="System" />
+ <Reference Include="System.Core" />
+ <Reference Include="System.Numerics" />
+ </ItemGroup>
+ <ItemGroup>
+ <Compile Include="AssemblyInfo.fs" />
+ <Compile Include="Logger.fs" />
+ </ItemGroup>
+ <PropertyGroup>
+ <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+ </PropertyGroup>
+ <Choose>
+ <When Condition="'$(VisualStudioVersion)' == '11.0'">
+ <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
+ <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
+ </PropertyGroup>
+ </When>
+ <Otherwise>
+ <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
+ <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
+ </PropertyGroup>
+ </Otherwise>
+ </Choose>
+ <Import Project="$(FSharpTargetsPath)" />
+ <!-- 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.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
\ No newline at end of file
# Visual Studio 14
VisualStudioVersion = 14.0.24720.0
MinimumVisualStudioVersion = 10.0.40219.1
-Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Parasitemia", "Parasitemia\Parasitemia.fsproj", "{70838E65-F211-44FC-B28F-0ED1CA6E850F}"
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ParasitemiaUI", "ParasitemiaUI\ParasitemiaUI.fsproj", "{70838E65-F211-44FC-B28F-0ED1CA6E850F}"
EndProject
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "WPF", "WPF\WPF.csproj", "{314FD78E-870E-4794-BB16-EA4586F2ABDB}"
EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Logger", "Logger\Logger.fsproj", "{A4F183AE-562A-4BAD-88E6-658B4CE15DC3}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ParasitemiaCore", "ParasitemiaCore\ParasitemiaCore.fsproj", "{0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}"
+EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
{314FD78E-870E-4794-BB16-EA4586F2ABDB}.DebugGUI|Any CPU.Build.0 = Debug|Any CPU
{314FD78E-870E-4794-BB16-EA4586F2ABDB}.Release|Any CPU.ActiveCfg = Release|Any CPU
{314FD78E-870E-4794-BB16-EA4586F2ABDB}.Release|Any CPU.Build.0 = Release|Any CPU
+ {A4F183AE-562A-4BAD-88E6-658B4CE15DC3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {A4F183AE-562A-4BAD-88E6-658B4CE15DC3}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {A4F183AE-562A-4BAD-88E6-658B4CE15DC3}.DebugGUI|Any CPU.ActiveCfg = Debug|Any CPU
+ {A4F183AE-562A-4BAD-88E6-658B4CE15DC3}.DebugGUI|Any CPU.Build.0 = Debug|Any CPU
+ {A4F183AE-562A-4BAD-88E6-658B4CE15DC3}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {A4F183AE-562A-4BAD-88E6-658B4CE15DC3}.Release|Any CPU.Build.0 = Release|Any CPU
+ {0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}.DebugGUI|Any CPU.ActiveCfg = Debug|Any CPU
+ {0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}.DebugGUI|Any CPU.Build.0 = Debug|Any CPU
+ {0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {0F8A85F4-9328-40C3-B8FF-44FB39CEB01F}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
+++ /dev/null
-<?xml version="1.0" encoding="utf-8"?>
-<configuration>
- <startup>
- <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.2" />
- </startup>
- <runtime>
- <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
- <dependentAssembly>
- <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
- <bindingRedirect oldVersion="0.0.0.0-4.4.0.0" newVersion="4.4.0.0" />
- </dependentAssembly>
- <dependentAssembly>
- <assemblyIdentity name="Castle.Core" publicKeyToken="407dd0808d44fbdc" culture="neutral" />
- <bindingRedirect oldVersion="0.0.0.0-1.1.0.0" newVersion="1.1.0.0" />
- </dependentAssembly>
- </assemblyBinding>
- </runtime>
-</configuration>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.AssemblyInfo
-
-open System.Reflection
-open System.Runtime.CompilerServices
-open System.Runtime.InteropServices
-
-// General Information about an assembly is controlled through the following
-// set of attributes. Change these attribute values to modify the information
-// associated with an assembly.
-[<assembly: AssemblyTitle("Parasitemia")>]
-[<assembly: AssemblyDescription("")>]
-[<assembly: AssemblyConfiguration("")>]
-[<assembly: AssemblyCompany("HES-SO / CHUV / Grégory Burri")>]
-[<assembly: AssemblyProduct("Parasitemia")>]
-[<assembly: AssemblyCopyright("Copyright © 2015-2016")>]
-[<assembly: AssemblyTrademark("")>]
-[<assembly: AssemblyCulture("")>]
-
-// Setting ComVisible to false makes the types in this assembly not visible
-// to COM components. If you need to access a type in this assembly from
-// COM, set the ComVisible attribute to true on that type.
-[<assembly: ComVisible(false)>]
-
-// The following GUID is for the ID of the typelib if this project is exposed to COM
-[<assembly: Guid("70838e65-f211-44fc-b28f-0ed1ca6e850f")>]
-
-// Version information for an assembly consists of the following four values:
-//
-// Major Version
-// Minor Version
-// Build Number
-// Revision
-//
-// 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.0")>]
-[<assembly: AssemblyFileVersion("1.0.0.0")>]
-
-do
- ()
\ No newline at end of file
+++ /dev/null
-module Classifier
-
-open System
-open System.Collections.Generic
-open System.Drawing
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Types
-open Utils
-
-
-type private EllipseFlaggedKd (e: Ellipse) =
- inherit Ellipse (e.Cx, e.Cy, e.A, e.B, e.Alpha)
-
- member val Removed = false with get, set
-
- interface KdTree.I2DCoords with
- member this.X = this.Cx
- member this.Y = this.Cy
-
-
-let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img: Image<Gray, float32>) (config: Config.Config) : Cell list =
- if ellipses.IsEmpty
- then
- []
- else
- let infection = parasites.infection.Copy() // To avoid to modify the parameter.
-
- // 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) }
-
- // The minimum window to contain a given 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
-
- let w = img.Width
- let w_f = float32 w
- let h = img.Height
- let h_f = float32 h
-
- // Return 'true' if the point 'p' is owned by e.
- // The lines represents all intersections with other ellipses.
- let pixelOwnedByE (p: PointD) (e: Ellipse) (others: (Ellipse * Line) list) =
- e.Contains p.X p.Y &&
- seq {
- let c = PointD(e.Cx, e.Cy)
- for e', d1 in others do
- let d2 = Utils.lineFromTwoPoints c p
- let c' = PointD(e'.Cx, e'.Cy)
- let v = pointFromTwoLines d1 (lineFromTwoPoints c c')
- let case1 = sign (v.X - c.X) <> sign (v.X - c'.X) || Utils.squaredDistanceTwoPoints v c > Utils.squaredDistanceTwoPoints v c'
- if d2.Valid
- then
- let p' = Utils.pointFromTwoLines d1 d2
- // Yield 'false' when the point is owned by another ellipse.
- if case1
- then
- yield sign (c.X - p.X) <> sign (c.X - p'.X) || Utils.squaredDistanceTwoPoints c p' > Utils.squaredDistanceTwoPoints c p
- else
- yield sign (c.X - p.X) = sign (c.X - p'.X) && Utils.squaredDistanceTwoPoints c p' < Utils.squaredDistanceTwoPoints c p
- else
- yield case1
- } |> Seq.forall id
-
- let ellipses = ellipses |> List.map EllipseFlaggedKd
-
- // 1) Associate touching ellipses with each ellipses and remove ellipse with more than two intersections.
- let tree = KdTree.Tree.BuildTree ellipses
- let neighbors (e: EllipseFlaggedKd) : (EllipseFlaggedKd * PointD * PointD) list =
- if not e.Removed
- then
- tree.Search (searchRegion e)
- // We only keep the ellipses touching 'e'.
- |> List.choose (fun otherE ->
- if e <> otherE
- then
- match EEOver.EEOverlapArea e otherE with
- | Some (_, px, _) when px.Length > 2 ->
- otherE.Removed <- true
- None
- | Some (area, px, py) when area > 0.f && px.Length = 2 ->
- Some (otherE, PointD(px.[0], py.[0]), PointD(px.[1], py.[1]))
- | _ ->
- None
- else
- None )
- else
- []
-
- // We reverse the list to get the lower score ellipses first.
- let ellipsesWithNeigbors = ellipses |> List.map (fun e -> e, neighbors e) |> List.rev
-
- // 2) Remove ellipses touching the edges.
- for e in ellipses do
- if e.isOutside w_f h_f then e.Removed <- true
-
- // 3) Remove ellipses with a high standard deviation (high contrast).
- let imgData = img.Data
- let globalStdDeviation = MathNet.Numerics.Statistics.Statistics.PopulationStandardDeviation(seq {
- for y in 0 .. h - 1 do
- for x in 0 .. w - 1 do
- yield float imgData.[y, x, 0] })
-
- for e in ellipses do
- 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
- yield float imgData.[y, x, 0] })
-
- if stdDeviation > globalStdDeviation * config.Parameters.standardDeviationMaxRatio then
- e.Removed <- true
-
-
- // 4) Remove ellipses with little area.
- let minArea = config.RBCRadius.MinArea
- for e, neighbors in ellipsesWithNeigbors do
- if not e.Removed
- then
- let minX, minY, maxX, maxY = ellipseWindow e
-
- let mutable area = 0
- for y in (if minY < 0 then 0 else minY) .. (if maxY >= h then h - 1 else maxY) do
- for x in (if minX < 0 then 0 else minX) .. (if maxX >= w then w - 1 else maxX) do
- let p = PointD(float32 x, float32 y)
- if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
- then
- area <- area + 1
-
- if area < int minArea
- then
- e.Removed <- true
-
- // 5) Define pixels associated to each ellipse and create the cells.
- ellipsesWithNeigbors
- |> List.choose (fun (e, neighbors) ->
- if e.Removed
- then
- None
- else
- let minX, minY, maxX, maxY = ellipseWindow e
-
- let infectedPixels = List<Point>()
- let mutable stainPixels = 0
- let mutable darkStainPixels = 0
- let mutable nbElement = 0
-
- let elements = new Matrix<byte>(maxY - minY + 1, maxX - minX + 1)
- for y in minY .. maxY do
- for x in minX .. maxX do
- let p = PointD(float32 x, float32 y)
- if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
- then
- elements.[y-minY, x-minX] <- 1uy
- nbElement <- nbElement + 1
-
- if infection.Data.[y, x, 0] > 0uy
- then
- infectedPixels.Add(Point(x, y))
-
- if parasites.stain.Data.[y, x, 0] > 0uy
- then
- stainPixels <- stainPixels + 1
-
- if parasites.darkStain.Data.[y, x, 0] > 0uy
- then
- darkStainPixels <- darkStainPixels + 1
-
- let cellClass =
- if float darkStainPixels > config.Parameters.maxDarkStainRatio * (float nbElement) ||
- float stainPixels > config.Parameters.maxStainRatio * (float nbElement)
- then
- Peculiar
- elif infectedPixels.Count >= 1
- then
- let infectionToRemove = ImgTools.connectedComponents parasites.stain infectedPixels
- for p in infectionToRemove do
- infection.Data.[p.Y, p.X, 0] <- 0uy
- InfectedRBC
- else
- HealthyRBC
-
- Some { cellClass = cellClass
- center = Point(roundInt e.Cx, roundInt e.Cy)
- infectedArea = infectedPixels.Count
- stainArea = stainPixels
- elements = elements })
+++ /dev/null
-module Config
-
-open System
-
-open Const
-open UnitsOfMeasure
-
-type Debug =
- | DebugOff
- | DebugOn of string // Output directory.
-
-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'.
-
- 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.
-
- LPFStandardDeviation: float<μm> // Sigma parameter of the gaussian to remove the high frequency noise.
-
- // Ellipse.
- factorNbPick: float // The number of computed ellipse per edge pixel.
-
- // 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.
-
- stainArea: float32 // Factor of a RBC area. 0.5 means the half of RBC area.
- stainSensitivity: float // between 0 (the least sensitive) and 1 (the most sensitive).
- maxStainRatio: float // A cell must own less than this ratio to be a RBC.
-
- infectionArea: 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).
-
- 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 = 8.<μm>
- resolution = 220.e3<ppi> // Correspond to 50X.
-
- ratioAreaPaleCenter = 1.f / 3.f // The ratio between an RBC area and the area of the its pale center.
-
- granulometryRange = 0.5f
-
- minRbcRadius = -0.3f
- maxRbcRadius = 0.3f
-
- LPFStandardDeviation = 0.2<μm> // 8.5e-6<inch>.
-
- factorNbPick = 1.0
-
- darkStainLevel = 0.25 // 0.3
- maxDarkStainRatio = 0.1 // 10 %
-
- infectionArea = 0.012f // 1.2 %
- infectionSensitivity = 0.9
-
- stainArea = 0.08f // 8 %
- stainSensitivity = 0.9
- maxStainRatio = 0.12 // 12 %
-
- standardDeviationMaxRatio = 0.5 // 0.5
- minimumCellAreaFactor = 0.4f }
-
-type RBCRadius (radius: float32, parameters: Parameters) =
- member this.Pixel = radius
- member this.μm : float<μm> =
- 1.<px> * (float radius) / parameters.resolution |> inchToμm
-
- member this.Min = radius + parameters.minRbcRadius * radius
- member this.Max = radius + parameters.maxRbcRadius * radius
-
- member this.Area = PI * radius ** 2.f
- member this.MinArea = parameters.minimumCellAreaFactor * radius
-
- member this.InfectionArea = parameters.infectionArea * this.Area
- member this.StainArea = parameters.stainArea * this.Area
-
- 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
- float32 rbcRadiusPx
-
- let mutable parameters: Parameters = param
- let mutable rbcRadiusByResolution = RBCRadius(RBCadiusInPixels parameters.rbcDiameter parameters.resolution, parameters)
- let mutable rbcRadius = RBCRadius(0.f, parameters)
-
- new () = Config(defaultParameters)
-
- member this.Parameters
- with get() = parameters
- and set(param) =
- parameters <- param
- rbcRadiusByResolution <- RBCRadius(RBCadiusInPixels parameters.rbcDiameter parameters.resolution, param)
- rbcRadius <- RBCRadius(rbcRadius.Pixel, param)
-
- member val Debug = DebugOff with get, set
-
- member this.LPFStandardDeviation =
- let stdDeviation: float<px> = (μmToInch parameters.LPFStandardDeviation) * parameters.resolution
- float stdDeviation
-
- member this.RBCRadiusByResolution = rbcRadiusByResolution
- member this.RBCRadius = rbcRadius
-
- member this.SetRBCRadius (radiusPixel: float32) =
- rbcRadius <- RBCRadius(radiusPixel, parameters)
-
- member this.Copy () =
- this.MemberwiseClone() :?> Config
-
+++ /dev/null
-module Const
-
-let PI = float32 System.Math.PI
\ No newline at end of file
+++ /dev/null
-module EEOver
-
-open System
-
-let private EPS = 1.0e-5
-
-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 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
-
- 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
-
-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 x =
- if abs x > a1
- then
- if x < 0.0 then -a1 else a1
- else x
-
- let theta =
- if y < 0.0
- then 2.0 * Math.PI - acos (x / a1)
- else acos (x / a1)
-
- let eps_radian = 0.1
-
- let x1 = a1 * cos (theta + eps_radian)
- let y1 = b1 * sin (theta + eps_radian)
- let x2 = a1 * cos (theta - eps_radian)
- let y2 = b1 * sin (theta - eps_radian)
-
- let test1 = ellipse2tr x1 y1 aa bb cc dd ee ff
- let test2 = ellipse2tr x2 y2 aa bb cc dd ee ff
-
-#if DEBUG_LOG
- printf "\t\t--- debug istanpt with (x,y)=(%f, %f), A1=%f, B1=%f\n" x y a1 b1
- printf "theta=%f\n" theta
- printf "eps_Radian=%f\n" eps_radian
- printf "(x1, y1)=(%f, %f)\n" x1 y1
- printf "(x2, y2)=(%f, %f)\n" x2 y2
- printf "test1=%f\n" test1
- printf "test2=%f\n" test2
-#endif
-
- 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 mutable theta1 =
- 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
-
- let mutable theta2 =
- if y.[1] < 0.0
- then 2.0 * Math.PI - acos (x.[1] / a1)
- else acos (x.[1] / a1)
-
- 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
- let tmp = theta1
- theta1 <- theta2
- theta2 <- tmp
-
- 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 DEBUG_LOG
- printf "TWO area1=%f\n" area1
-#endif
- area1 <- area1 + a1 * b1
-
- let cosphi = cos (phi_1 - phi_2)
- let sinphi = sin (phi_1 - phi_2)
-
- let mutable x1_tr = (x.[0] - h2_tr) * cosphi + (y.[0] - k2_tr) * -sinphi
- let mutable y1_tr = (x.[0] - h2_tr) * sinphi + (y.[0] - k2_tr) * cosphi
- 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
- x1_tr <- if x1_tr < 0.0 then -a2 else a2
-
- 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
- x2_tr <- if x2_tr < 0.0 then -a2 else a2
-
- 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
- let tmp = theta1
- theta1 <- theta2
- theta2 <- tmp
-
- let xmid = a2 * cos ((theta1 + theta2) / 2.0)
- let ymid = b2 * sin ((theta1 + theta2) / 2.0)
-
- let cosphi = cos (phi_2 - phi_1)
- let sinphi = sin (phi_2 - phi_1)
- 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
- let tmp = theta1
- theta1 <- theta2
- theta2 <- tmp
-
- 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 DEBUG_LOG
- printf "TWO area2=%f\n" area2
-#endif
- area2 <- area2 + a2 * b2
-
- 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 mutable tanpts = 0
- let mutable tanindex = 0
- for i in 0..2 do
- 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
- -1.0
- else
- match tanindex with
- | 0 ->
- xint.[0] <- xint.[2]
- yint.[0] <- yint.[2]
- | 1 ->
- xint.[1] <- xint.[2]
- yint.[1] <- yint.[2]
- | _ ->
- ()
- 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 a1b1 = a1 * b1
- let a2b2 = a2 * b2
- let area_1 = Math.PI * a1b1
- let area_2 = Math.PI * a2b2
-
- let theta = Array.zeroCreate 4
-
- for i in 0 .. 3 do
- 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)
-
-#if DEBUG_LOG
- for k in 0..3 do
- printf "k=%d: Theta = %f, xint=%f, yint=%f\n" k theta.[k] xint.[k] yint.[k]
-#endif
-
- for j in 1 .. 3 do
- let tmp0 = theta.[j]
- let tmp1 = xint.[j]
- let tmp2 = yint.[j]
-
- let mutable k = j - 1
- let mutable k2 = 0
- while k >= 0 do
- if theta.[k] <= tmp0
- then
- k2 <- k + 1
- k <- -1
- else
- theta.[k+1] <- theta.[k]
- xint.[k+1] <- xint.[k]
- yint.[k+1] <- yint.[k]
- k <- k - 1
- k2 <- k + 1
-
- theta.[k2] <- tmp0
- xint.[k2] <- tmp1
- yint.[k2] <- tmp2
-
-
-#if DEBUG_LOG
- printf "AFTER sorting\n"
- for k in 0..3 do
- printf "k=%d: Theta = %f, xint=%f, yint=%f\n" k theta.[k] xint.[k] yint.[k]
-#endif
-
- let area1 = 0.5 * abs ((xint.[2] - xint.[0]) * (yint.[3] - yint.[1]) - (xint.[3] - xint.[1]) * (yint.[2] - yint.[0]))
-
- let cosphi = cos (phi_1 - phi_2)
- let sinphi = sin (phi_1 - phi_2)
-
- let theta_tr = Array.zeroCreate 4
- let xint_tr = Array.zeroCreate 4
- let yint_tr = Array.zeroCreate 4
-
- for i in 0..3 do
- 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
- 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 xmid = a1 * cos ((theta.[0] + theta.[1]) / 2.0)
- let ymid = b1 * sin ((theta.[0] + theta.[1]) / 2.0)
-
- 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
- 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
- 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]))
- else
- area2 <- 0.5 * (a1b1 * (theta.[2] - theta.[1]) - abs (xint.[1] * yint.[2] - xint.[2] * yint.[1]))
- area3 <- 0.5 * (a1b1 * (theta.[0] - (theta.[3] - 2.0 * Math.PI)) - abs (xint.[3] * yint.[0] - xint.[0] * yint.[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 DEBUG_LOG
- printf "\n\t\t-------------> area5 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area5 area_2
-#endif
- area5 <- area5 + area_2
-
- if area4 < 0.0
- then
-#if DEBUG_LOG
- printf "\n\t\t-------------> area4 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area4 area_2
-#endif
- area4 <- area4 + area_2
-
- if area3 < 0.0
- then
-#if DEBUG_LOG
- printf "\n\t\t-------------> area3 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area3 area_1
-#endif
- area3 <- area3 + area_1
-
- if area2 < 0.0
- then
-#if DEBUG_LOG
- printf "\n\t\t-------------> area2 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area2 area_1
-#endif
- area2 <- area2 + area_1
-
-#if DEBUG_LOG
- printf "\narea1=%f, area2=%f area3=%f, area4=%f, area5=%f\n\n" area1 area2 area3 area4 area5
-#endif
-
- area1 + area2 + area3 + area4 + area5
-
-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
- b <- sqrt d + b
- r.[1, 2] <- b
- else
- b <- -sqrt d + b
- r.[1, 2] <- b
- r.[1, 1] <- c / b
- r.[2, 1] <- 0.0
- r.[2, 2] <- 0.0
- else
- d <- sqrt -d
- r.[2, 1] <- d
- r.[2, 2] <- -d
- r.[1, 1] <- b
- r.[1, 2] <- b
-
-let private cubicroots (p: float[]) (r: float[,]) =
- if p.[0] <> 1.0 then
- for k in 1..3 do
- p.[k] <- p.[k] / p.[0]
- p.[0] <- 1.0
- let s = p.[1] / 3.0
- let mutable t = s * p.[1]
- let mutable b = 0.5 * (s * (t / 1.5 - p.[2]) + p.[3])
- t <- (t - p.[2]) / 3.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
- 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
- r.[1, 1] <- c
- r.[2, 1] <- -d
- r.[1, 3] <- b - s
- r.[2, 3] <- 0.0
- else
- r.[1, 1] <- b - s
- r.[2, 1] <- 0.0
- 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 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
- d <- -t - c - s
- c <- c - s
- t <- t - s
-
- if abs c > abs t
- then
- r.[1, 3] <- c
- else
- r.[1, 3] <- t
- t <- c
-
- if abs d > abs t
- then
- r.[1, 2] <- d
- else
- r.[1, 2] <- t
- t <- d
-
- r.[1, 1] <- t
- for k in 1..3 do
- r.[2, k] <- 0.0
-
-let private biquadroots (p: float[]) (r: float[,]) =
- if p.[0] <> 1.0
- then
- for k in 1..4 do
- p.[k] <- p.[k] / p.[0]
- p.[0] <- 1.0
- let e = 0.25 * p.[1]
- let mutable b = 2.0 * e
- let mutable c = b ** 2.0
- let mutable d = 0.75 * c
- b <- p.[3] + b *(c - p.[2])
- let mutable a = p.[2] - d
- c <- p.[4] + e * (e * a - p.[3])
- a <- a - d
-
- let mutable quadExecuted = false
- let inline quad () =
- if not quadExecuted
- then
- p.[2] <- c / b
- quadroots p r
- for k in 1..2 do
- for j in 1..2 do
- r.[j, k+2] <- r.[j, k]
- p.[1] <- -p.[1]
- p.[2] <- b
- quadroots p r
- for k in 1..4 do
- r.[1,k] <- r.[1,k] - e
- quadExecuted <- true
-
- 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
- cubicroots p r
- let mutable k = 1
- while k < 4 do
- 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
- p.[1] <- sqrt d
- elif a <= 0.0 && b <= 0.0
- then
- p.[1] <- sqrt d
- else
- p.[1] <- -(sqrt d)
- b <- 0.5 * (a + b / p.[1])
- quad ()
- k <- 4
- k <- k + 1
-
- if not quadExecuted && p.[2] < 0.0
- then
- b <- sqrt c
- d <- b + b - a
- p.[1] <- 0.0
- if d > 0.0
- then
- p.[1] <- sqrt d
- 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
- p.[1] <- 0.0
- else
- for k in 1..4 do
- r.[1, k] <- -e
- r.[2, k] <- 0.0
- quadExecuted <- true
-
- quad ()
-
-// Return a tuple (area, x intersections, y intersections)
-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
- None
- else
- let phi_1 = phi_1 % Math.PI //(if phi_1 > Math.PI / 2.0 then phi_1 - Math.PI else phi_1) % Math.PI
- let phi_2 = phi_2 % Math.PI //(if phi_2 > Math.PI / 2.0 then phi_2 - Math.PI else phi_2) % Math.PI
- let h2_tr, k2_tr, phi_2r =
- let cosphi = cos phi_1
- let sinphi = sin phi_1
- (h2 - h1) * cosphi + (k2 - k1) * sinphi, (h1 - h2) * sinphi + (k2 - k1) * cosphi, (phi_2 - phi_1) % (2.0 * Math.PI)
-
-#if DEBUG_LOG
- printf "H2_TR=%f, K2_TR=%f, PHI_2R=%f\n" h2_tr k2_tr phi_2r
-#endif
-
- let cosphi = cos phi_2r
- let cosphi2 = cosphi ** 2.0
- let sinphi = sin phi_2r
- let sinphi2 = sinphi ** 2.0
- let cosphisinphi = 2.0 * cosphi * sinphi
- let a22 = a2 ** 2.0
- let b22 = b2 ** 2.0
- let tmp0 = (cosphi * h2_tr + sinphi * k2_tr) / a22
- let tmp1 = (sinphi * h2_tr - cosphi * k2_tr) / b22
- let tmp2 = cosphi * h2_tr + sinphi * k2_tr
- let tmp3 = sinphi * h2_tr - cosphi * k2_tr
-
- let aa = cosphi2 / a22 + sinphi2 / b22
- let bb = cosphisinphi / a22 - cosphisinphi / b22
- let cc = sinphi2 / a22 + cosphi2 / b22
- let dd = -2.0 * cosphi * tmp0 - 2.0 * sinphi * tmp1
- let ee = -2.0 * sinphi * tmp0 + 2.0 * cosphi * tmp1
- let ff = tmp2 * tmp2 / a22 + tmp3 * tmp3 / b22 - 1.0
-
- let cy = [|
- (a1 * (a1 * aa - dd) + ff) * (a1 * (a1 * aa + dd) + ff)
- 2.0 * b1 * (a1 * a1 * (aa * ee - bb * dd) + ee * ff)
- a1 * a1 * ((b1 * b1 * (2.0 * aa * cc - bb * bb) + dd * dd - 2.0 * aa * ff) - 2.0 * a1 * a1 * aa * aa) + b1 * b1 * (2.0 * cc * ff + ee * ee)
- 2.0 * b1 * (b1 * b1 * cc * ee + a1 * a1 * (bb * dd - aa * ee))
- a1 * a1 * a1 * a1 * aa * aa + b1 * b1 * (a1 * a1 * (bb * bb - 2.0 * aa * cc) + b1 * b1 * cc * cc)
- |]
-
-#if DEBUG_LOG
- for i in 0..4 do
- printf "cy[%d]=%f\n" i cy.[i]
-#endif
-
- let py = Array.zeroCreate<float> 5
- let r = Array2D.zeroCreate<float> 3 5
-
- let nroots =
- if abs cy.[4] > EPS
- then
- for i in 0 .. 3 do
- py.[4-i] <- cy.[i] / cy.[4]
- py.[0] <- 1.0
-#if DEBUG_LOG
- for i in 0..4 do
- printf "py[%d]=%f\n" i py.[i]
-#endif
- biquadroots py r
- 4
-
- elif abs cy.[3] > EPS
- then
- for i in 0..2 do
- py.[3 - i] <- cy.[i] / cy.[3]
- py.[0] <- 1.0
- cubicroots py r
- 3
-
- elif abs cy.[2] > EPS
- then
- for i in 0..1 do
- py.[2-i] <- cy.[i] / cy.[2]
- py.[0] <- 1.0
- quadroots py r
- 2
-
- elif abs cy.[1] > EPS
- then
- r.[1, 1] <- -cy.[0] / cy.[1]
- r.[2, 1] <- 0.0
- 1
-
- else
- 0
-
-#if DEBUG_LOG
- printf "nroots = %d\n" nroots
-#endif
-
- let ychk = Array.init nroots (fun _ -> Double.MaxValue)
- let mutable nychk = 0
- for i in 1 .. nroots do
- if abs r.[2, i] < EPS
- then
- ychk.[nychk] <- r.[1, i] * b1
- nychk <- nychk + 1
-#if DEBUG_LOG
- printf "ROOT is Real, i=%d --> %f (B1=%f)\n" i r.[1, i] b1
-#endif
- Array.sortInPlace ychk
-
-#if DEBUG_LOG
- printf "nychk=%d\n" ychk.Length
- for j in 0 .. ychk.Length - 1 do
- printf "\t j=%d, ychk=%f\n" j ychk.[j]
-#endif
-
- let mutable nintpts = 0
-
- let xint = Array.zeroCreate 4
- let yint = Array.zeroCreate 4
-
- let mutable returnValue = 0.0
-
- let mutable i = 0
- while returnValue = 0.0 && i < nychk do
-#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 DEBUG_LOG
- printf "check intersecting points. nintps is %d" nintpts
-#endif
-
- let x1 = if abs ychk.[i] > b1 then 0.0 else a1 * sqrt (1.0 - (ychk.[i] * ychk.[i]) / (b1 * b1))
- let x2 = -x1
-
-#if DEBUG_LOG
- printf "\tx1=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x1)= %f\n" x1 ychk.[i] a1 b1 (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff)
- printf "\tx2=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x2) %f\n" x2 ychk.[i] a1 b1 (ellipse2tr x2 ychk.[i] aa bb cc dd ee ff)
-#endif
-
- 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
- returnValue <- -1.0
- else
- xint.[nintpts-1] <- x1
- yint.[nintpts-1] <- ychk.[i]
-#if DEBUG_LOG
- 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
- 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
- returnValue <- -1.0
- else
- xint.[nintpts-1] <- x2
- yint.[nintpts-1] <- ychk.[i]
-
-#if DEBUG_LOG
- printf "nintpts=%d, x1=%f, xint=%f, i=%d, yint=%f\n" nintpts x1 x2 i ychk.[i]
-#endif
-
-#if DEBUG_LOG
- else
- printf "i=%d, multiple roots: %f <--------> %f. continue\n" i ychk.[i] ychk.[i-1]
-#endif
- i <- i + 1
-
-
- if returnValue = -1.0
- then
- None
- else
- let area =
- match nintpts with
- | 0 | 1 -> nointpts a1 b1 a2 b2 h1 k1 h2 k2 phi_1 phi_2 h2_tr k2_tr aa bb cc dd ee ff
- | 2 -> match istanpt xint.[0] yint.[0] a1 b1 aa bb cc dd ee ff with
- | TANGENT_POINT ->
-#if DEBUG_LOG
- printf "one point is tangent\n"
-#endif
- nointpts a1 b1 a2 b2 h1 k1 h2 k2 phi_1 phi_2 h2_tr k2_tr aa bb cc dd ee ff
-
- | INTERSECTION_POINT ->
-#if DEBUG_LOG
- printf "check twointpts\n"
-#endif
- twointpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
- | 3 -> threeintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
- | 4 -> fourintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
- | _ -> -1.0
- if nintpts = 0
- then Some (float32 area, [||], [||])
- else
- let xTransform : float32[] = Array.zeroCreate nintpts
- let yTransform : float32[] = Array.zeroCreate nintpts
- for i in 0 .. (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
+++ /dev/null
-module Ellipse
-
-open System
-open System.Collections.Generic
-open System.Drawing
-
-open MathNet.Numerics.LinearAlgebra
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Utils
-open Config
-open MatchingEllipses
-open Const
-
-type private SearchExtremum = Minimum | Maximum
-
-let private goldenSectionSearch (f: float -> float) (nbIter: int) (xmin: float) (xmax: float) (searchExtremum: SearchExtremum) : (float * float) =
- let gr = 1. / 1.6180339887498948482
- let mutable a = xmin
- let mutable b = xmax
- let mutable c = b - gr * (b - a)
- let mutable d = a + gr * (b - a)
-
- for i in 1 .. nbIter do
- let mutable fc = f c
- let mutable fd = f d
-
- if searchExtremum = Maximum
- then
- let tmp = fc
- fc <- fd
- fd <- tmp
-
- if fc < fd
- then
- b <- d
- d <- c
- c <- b - gr * (b - a)
- else
- a <- c
- c <- d
- d <- a + gr * (b - a)
-
- let x = (b + a) / 2.
- x, f x
-
-// Ellipse.A is always equal or greater than Ellipse.B.
-// Ellipse.Alpha is between 0 and Pi.
-let ellipse (p1x: float) (p1y: float) (m1: float) (p2x: float) (p2y: float) (m2: float) (p3x: float) (p3y: float) : Types.Ellipse option =
- let accuracy_extremum_search_1 = 10 // 3
- let accuracy_extremum_search_2 = 10 // 4
-
- // p3 as the referencial.
- let p1x = p1x - p3x
- let p1y = p1y - p3y
-
- let p2x = p2x - p3x
- let p2y = p2y - p3y
-
- // Convert to polar coordinates.
- let alpha1 = atan m1
- let alpha2 = atan m2
-
- let r1 = sqrt (p1x ** 2. + p1y ** 2.)
- let theta1 = atan2 p1y p1x
-
- let r2 = sqrt (p2x ** 2. + p2y ** 2.)
- let theta2 = atan2 p2y p2x
-
- let valid =
- 4. * sin (alpha1 - theta1) * (-r1 * sin (alpha1 - theta1) + r2 * sin (alpha1 - theta2)) *
- sin (alpha2 - theta2) * (-r1 * sin (alpha2 - theta1) + r2 * sin (alpha2 - theta2)) +
- r1 * r2 * sin (alpha1 - alpha2) ** 2. * sin (theta1 - theta2) ** 2. < 0.
-
- if valid
- then
- let r theta =
- (r1 * r2 * (r1 * (cos (alpha2 + theta - theta1 - theta2) - cos (alpha2 - theta) * cos (theta1 - theta2)) * sin (alpha1 - theta1) + r2 * (-cos (alpha1 + theta - theta1 - theta2) + cos (alpha1 - theta) * cos (theta1 - theta2)) * sin (alpha2 - theta2)) * sin (theta1 - theta2)) /
- (sin (alpha1 - theta1) * sin (alpha2 - theta2) * (r1 * sin (theta - theta1) - r2 * sin (theta - theta2)) ** 2. - r1 * r2 * sin (alpha1 - theta) * sin (alpha2 - theta) * sin (theta1 - theta2) ** 2.)
-
- let rabs = r >> abs
-
- // We search for an interval [theta_a, theta_b] and assume the function is unimodal in this interval.
- let thetaTan, _ = goldenSectionSearch rabs accuracy_extremum_search_1 0. Math.PI Maximum
- let rTan = r thetaTan
-
- let PTanx = rTan * cos thetaTan
- let PTany = rTan * sin thetaTan
-
- let d1a = tan alpha1
- let d1b = -d1a * p1x + p1y
-
- let d2a = tan alpha2
- let d2b = -d2a * p2x + p2y
-
- let d3a = -1. / tan thetaTan
- let d3b = -d3a * PTanx + PTany
-
- let Ux = -(d1b - d2b) / (d1a - d2a)
- let Uy = -(d2a * d1b - d1a * d2b) / (d1a - d2a)
-
- let Vx = -(d1b - d3b) / (d1a - d3a)
- let Vy = -(d3a * d1b - d1a * d3b) / (d1a - d3a)
-
- let Wx = p1x + (p2x - p1x) / 2.
- let Wy = p1y + (p2y - p1y) / 2.
-
- let Zx = p1x + (PTanx - p1x) / 2.
- let Zy = p1y + (PTany - p1y) / 2.
-
- let va = -(-Vy + Zy) / (Vx - Zx)
- let vb = -(Zx * Vy - Vx * Zy) / (Vx - Zx)
-
- let ua = -(-Uy + Wy) / (Ux - Wx)
- let ub = -(Wx * Uy - Ux * Wy) / (Ux - Wx)
-
- let cx = -(vb - ub) / (va - ua)
- let cy = -(ua * vb - va * ub) / (va - ua)
-
- let rc = sqrt (cx ** 2. + cy ** 2.)
- let psi = atan2 cy cx
-
- let rellipse theta =
- sqrt (
- rc ** 2. + (r1 ** 2. * r2 ** 2. * (r1 * (cos (alpha2 + theta - theta1 - theta2) - cos (alpha2 - theta) * cos (theta1 - theta2)) * sin (alpha1 - theta1) + r2 * (-cos (alpha1 + theta - theta1 - theta2) + cos (alpha1 - theta) * cos (theta1 - theta2)) * sin (alpha2 - theta2)) ** 2. * sin (theta1 - theta2) ** 2.) /
- (sin (alpha1 - theta1) * sin (alpha2 - theta2) * (r1 * sin (theta - theta1) - r2 * sin (theta - theta2)) ** 2. - r1 * r2 * sin (alpha1 - theta) * sin (alpha2 - theta) * sin (theta1 - theta2) ** 2.) ** 2. -
- (2. * r1 * r2 * rc * cos (theta - psi) * (r1 * (cos (alpha2 + theta - theta1 - theta2) - cos (alpha2 - theta) * cos (theta1 - theta2)) * sin (alpha1 - theta1) + r2 * (-cos (alpha1 + theta - theta1 - theta2) + cos (alpha1 - theta) * cos (theta1 - theta2)) * sin (alpha2 - theta2)) * sin (theta1 - theta2)) /
- (sin (alpha1 - theta1) * sin (alpha2 - theta2) * (r1 * sin (theta - theta1) - r2 * sin (theta - theta2)) ** 2. - r1 * r2 * sin (alpha1 - theta) * sin (alpha2 - theta) * sin (theta1 - theta2) ** 2.))
-
- // We search for an interval [theta_a, theta_b] and assume the function is unimodal in this interval.
- let r1eTheta, r1e = goldenSectionSearch rellipse accuracy_extremum_search_2 0. (Math.PI / 2.) Maximum // Pi/2 and not pi because the period is Pi.
- let r2eTheta, r2e = goldenSectionSearch rellipse accuracy_extremum_search_2 0. (Math.PI / 2.) Minimum
-
- let rr1e = r r1eTheta
- let r1ex = rr1e * cos r1eTheta
- let r1ey = rr1e * sin r1eTheta
- let mutable alpha = atan ((r1ey - cy) / (r1ex - cx))
- if alpha < 0.
- then
- alpha <- alpha + Math.PI
-
- // Ride off the p3 referential.
- let cx = cx + p3x
- let cy = cy + p3y
-
- Some (Types.Ellipse(float32 cx, float32 cy, float32 r1e, float32 r2e, float32 alpha))
- else
- None
-
-let ellipse2 (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 v0 = matrix [[ 1.; p0x; p0y ]]
- let v1 = matrix [[ 1.; p1x; p1y ]]
- let v2 = matrix [[ 1.; p2x; p2y ]]
- let v3 = matrix [[ 1.; p3x; p3y ]]
-
- let p = (v3.Stack(v1).Stack(v2).Determinant() * v0).Stack(v0.Stack(v3).Stack(v2).Determinant() * v1).Stack(v0.Stack(v1).Stack(v3).Determinant() * v2).Transpose()
- let conicMat = p * s.Inverse() * p.Transpose()
- let a = conicMat.[0, 0]
- let b = conicMat.[0, 1]
- let c = conicMat.[1, 1]
- let d = conicMat.[0, 2]
- let e = conicMat.[1, 2]
- let f = conicMat.[2, 2]
-
- // Center.
- let cx = b / a
- let cy = d / a
-
- let at = c * f - e ** 2. + (e * d - b * f) * cx + (b * e - c * d) * cy
- 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 eigen = q.Evd()
- let eigenValues = eigen.EigenValues
- let lambda = eigenValues.[1].Real
- let mu = eigenValues.[0].Real
-
- if lambda <= 0. || mu <= 0.
- then
- None
- else
- let r1, r2 = 1. / (sqrt lambda), 1. / (sqrt mu)
-
- let eigenVectors = eigen.EigenVectors
- let v_a = eigenVectors.[0, 0]
- let v_b = eigenVectors.[1, 0] // [0, 1]
-
- // Angle against the longest axis.
- let phi = (if r2 > r1 then atan (v_b / v_a) else atan (v_a / v_b))
-
- let phi' = if phi < 0. then phi + Math.PI else phi
- let majorAxis, minorAxis = if r1 > r2 then r1, r2 else r2, r1
-
- Some (Types.Ellipse(float32 cx, float32 cy, float32 majorAxis, float32 minorAxis, float32 phi'))
-
-
-let private vectorRotation (p1x: float32) (p1y: float32) (v1x: float32) (v1y: float32) (px: float32) (py: float32) : float32 =
- let mutable rotation = 1.f
- if p1y > py
- then
- if v1x > 0.f
- then
- rotation <- -1.f
- elif p1y < py
- then
- if v1x < 0.f
- then
- rotation <- -1.f
- elif p1x > px
- then
- if v1y < 0.f
- then
- rotation <- -1.f
- elif p1x < px
- then
- if v1y > 0.f
- then
- rotation <- -1.f
- rotation
-
-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 b1 = -m1 * p1x + p1y
- let b2 = -m2 * p2x + p2y
- let px = -((b1 - b2) / (m1 - m2))
- let py = -((m2 * b1 - m1 * b2) / (m1 - m2))
-
- let rot1 = vectorRotation p1x p1y v1x v1y px py
- let rot2 = vectorRotation p2x p2y v2x v2y px py
-
- if rot1 = rot2
- then
- None
- else
- let alpha1 = atan2 (p1y - py) (p1x - px)
- let alpha2 = atan2 (p2y - py) (p2x - px)
-
- let alpha1' = if alpha1 < 0.f then 2.f * PI + alpha1 else alpha1
- let alpha2' = if alpha2 < 0.f then 2.f * PI + alpha2 else alpha2
-
- let diff = rot1 * alpha1' + rot2 * alpha2'
-
- if diff > PI || (diff < 0.f && diff > -PI)
- then
- None
- else
- Some (m1, m2)
-
-
-let find (edges: Matrix<byte>)
- (xGradient: Image<Gray, float32>)
- (yGradient: Image<Gray, float32>)
- (config: Config) : MatchingEllipses =
-
- let r1, r2 = config.RBCRadius.Min, config.RBCRadius.Max
- let incrementWindowDivisor = 4.f
-
- // We choose a window size for which the biggest ellipse can always be fitted in.
- let windowSize = roundInt (2.f * r2 / (incrementWindowDivisor - 1.f) * incrementWindowDivisor)
- let factorNbPick = config.Parameters.factorNbPick
-
- let increment = windowSize / (int incrementWindowDivisor)
-
- let radiusTolerance = (r2 - r1) * 0.2f
-
- let squaredMinimumDistance = (float r2 / 1.5) ** 2.
- let inline squaredDistance x1 y1 x2 y2 = (x1 - x2) ** 2. + (y1 - y2) ** 2.
-
- let h = edges.Height
- let w = edges.Width
- let h_f = float32 h
- let w_f = float32 w
-
- let mutable last_i, last_j = Int32.MaxValue, Int32.MaxValue
-
- let currentElements = List<Point>()
-
- let edgesData = edges.Data
- let xDirData = xGradient.Data
- let yDirData = yGradient.Data
-
- let rng = Random(42)
-
- let ellipses = MatchingEllipses(config.RBCRadius.Pixel)
-
- for window_i in -windowSize + increment .. increment .. h - increment do
- for window_j in -windowSize + increment .. increment .. w - increment do
-
- let window_i_begin = if window_i < 0 then 0 else window_i
- let window_i_end = if window_i + windowSize - 1 >= h then h - 1 else window_i + windowSize - 1
- let window_j_begin = if window_j < 0 then 0 else window_j
- let window_j_end = if window_j + windowSize - 1 >= w then w - 1 else window_j + windowSize - 1
-
- // Remove old elements.
- let indexFirstElement = currentElements.FindIndex(fun p -> p.X >= window_j_begin)
- 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 in (if newElemsBegin_j < 0 then 0 else newElemsBegin_j) .. (if newElemsEnd_j >= w then w - 1 else newElemsEnd_j) do
- for i in window_i_begin .. window_i_end do
- if edgesData.[i, j] = 1uy
- then currentElements.Add(Point(j, i))
-
- if currentElements.Count >= 10
- then
- let mutable nbOfPicks = (float currentElements.Count) * factorNbPick |> int
- while nbOfPicks > 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
- nbOfPicks <- nbOfPicks - 1
- let p1yf, p1xf = float p1.Y, float p1.X
- let p2yf, p2xf = float p2.Y, float p2.X
- let p3yf, p3xf = float p3.Y, float p3.X
- if squaredDistance p1xf p1yf p2xf p2yf >= squaredMinimumDistance &&
- squaredDistance p1xf p1yf p3xf p3yf >= squaredMinimumDistance &&
- squaredDistance p2xf p2yf p3xf p3yf >= squaredMinimumDistance
- then
- match areVectorsValid (float32 p1xf) (float32 p1yf) (float32 p2xf) (float32 p2yf) -xDirData.[p1.Y, p1.X, 0] -yDirData.[p1.Y, p1.X, 0] -xDirData.[p2.Y, p2.X, 0] -yDirData.[p2.Y, p2.X, 0] with
- | Some (m1, m2) ->
- //let pouet = ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf
- match ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf with
- | Some e when e.Cx > 0.f && e.Cx < w_f - 1.f && e.Cy > 0.f && e.Cy < h_f - 1.f &&
- e.A >= r1 - radiusTolerance && e.A <= r2 + radiusTolerance && e.B >= r1 - radiusTolerance && e.B <= r2 + radiusTolerance ->
- ellipses.Add e
- | _ -> ()
- | _ -> ()
-
- currentElements.Clear()
-
- ellipses
-
+++ /dev/null
-module Parasitemia.GUI.About
-
-open System
-open System.Windows
-open System.Windows.Media
-open System.Windows.Markup
-open System.Windows.Shapes
-open System.Windows.Controls
-open System.Diagnostics
-
-let showWindow (parent: Window) =
- let window = Views.AboutWindow()
- window.Root.Owner <- parent
- window.Root.Left <- parent.Left + parent.ActualWidth / 2. - window.Root.Width / 2.
- window.Root.Top <- parent.Top + parent.ActualHeight / 2. - window.Root.Height / 2.
-
- let ctrl (name: string): 'a = window.Root.FindName(name) :?> 'a
-
- let butClose: Button = ctrl "butClose"
- let txtAbout: TextBlock = ctrl "txtAbout"
-
- let version = System.Reflection.Assembly.GetEntryAssembly().GetName().Version
- let txtVersion = sprintf "%d.%d.%d" version.Major version.Minor version.Revision
- txtAbout.Inlines.FirstInline.ElementEnd.InsertTextInRun(txtVersion)
-
-#if DEBUG
- txtAbout.Inlines.FirstInline.ElementEnd.InsertTextInRun(" - DEBUG")
-#endif
-
- butClose.Click.AddHandler(fun obj args -> window.Root.Close())
-
- window.Root.ShowDialog() |> ignore
-
+++ /dev/null
-<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d"
- x:Name="AboutWindow" Height="200.969" Width="282.313" MinHeight="100" MinWidth="100" Title="About" Icon="pack://application:,,,/Resources/icon.ico">
- <Grid>
- <Grid.RowDefinitions>
- <RowDefinition Height="Auto"/>
- <RowDefinition Height="Auto"/>
- <RowDefinition/>
- </Grid.RowDefinitions>
- <Image HorizontalAlignment="Left" Height="64" VerticalAlignment="Top" Width="64" Margin="6" Source="pack://application:,,,/Resources/icon.ico"/>
- <TextBlock x:Name="txtAbout" HorizontalAlignment="Left" Margin="6" Grid.Row="1" TextWrapping="Wrap">
- <Bold>Parasitemia </Bold>
- <LineBreak />
- <Hyperlink NavigateUri="http://www.hes-so.ch">HES-SO</Hyperlink> /
- <Hyperlink NavigateUri="http://www.chuv.ch/">CHUV</Hyperlink>
- <LineBreak />
- Grégory Burri
- </TextBlock>
- <Button x:Name="butClose" Content="Close" HorizontalAlignment="Right" Margin="3" VerticalAlignment="Bottom" Width="75" Grid.Row="2" Height="20"/>
- </Grid>
-</Window>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open FsXaml
-
-type AboutWindow = XAML<"GUI/AboutWindow.xaml">
-
+++ /dev/null
-module Parasitemia.GUI.Analysis
-
-open System
-open System.IO
-open System.Linq
-open System.Windows
-open System.Windows.Media
-open System.Windows.Markup
-open System.Windows.Shapes
-open System.Windows.Controls
-open System.Diagnostics
-open Microsoft.Win32 // For the common dialogs.
-
-open Emgu.CV.WPF
-
-open UnitsOfMeasure
-open Config
-open Types
-
-let showWindow (parent: Window) (state: State.State) : bool =
- let window = Views.AnalysisWindow()
- window.Root.Owner <- parent
- window.Root.Left <- parent.Left + parent.ActualWidth / 2. - window.Root.Width / 2.
- window.Root.Top <- parent.Top + parent.ActualHeight / 2. - window.Root.Height / 2.
-
- let ctrl (name: string): 'a = window.Root.FindName(name) :?> 'a
-
- let butClose: Button = ctrl "butClose"
- let butStart: Button = ctrl "butStart"
-
- let stackImagesSourceSelection: StackPanel = ctrl "stackImagesSourceSelection"
- let progressBar: ProgressBar = ctrl "progress"
- let textLog: TextBlock = ctrl "textLog"
- let scrollLog: ScrollViewer = ctrl "scrollLog"
-
- Utils.log <- (fun mess -> window.Root.Dispatcher.Invoke(fun () ->
- textLog.Inlines.Add(Documents.Run(mess))
- textLog.Inlines.Add(Documents.LineBreak())
- scrollLog.ScrollToBottom()))
-
- let minPPI = 1.
- let maxPPI = 10e6
- let parseAndValidatePPI (input: string) : float option =
- let res = ref 0.
- if Double.TryParse(input, res) && !res >= minPPI && !res <= maxPPI
- then Some !res
- else None
-
- let monitor = Object()
- let mutable atLeastOneAnalysisPerformed = false
- let mutable analysisPerformed = false
- let mutable analysisCancelled = false
-
- let updateSourceImages () =
- stackImagesSourceSelection.Children.Clear()
- let width = int stackImagesSourceSelection.ActualWidth
- for srcImg in state.SourceImages do
- let imageSourceSelection = Views.ImageSourceSelection(Tag = srcImg, Margin = Thickness(3.))
-
- let updateResolution () =
- match parseAndValidatePPI imageSourceSelection.txtResolution.Text with
- | Some resolution -> srcImg.config.Parameters <- { srcImg.config.Parameters with resolution = resolution * 1.<ppi> }
- | None -> ()
-
- imageSourceSelection.txtImageNumber.Text <- srcImg.num.ToString()
- let height = srcImg.img.Height * width / srcImg.img.Width
- imageSourceSelection.imagePreview.Source <- BitmapSourceConvert.ToBitmapSource(srcImg.img.Resize(width, height, Emgu.CV.CvEnum.Inter.Cubic))
- imageSourceSelection.chkSelection.IsChecked <- Nullable<bool>(srcImg.dateLastAnalysis.Ticks = 0L)
- imageSourceSelection.lblDateLastAnalysis.Content <- if srcImg.dateLastAnalysis.Ticks = 0L then "<Never>" else srcImg.dateLastAnalysis.ToString()
-
- imageSourceSelection.txtResolution.Text <- srcImg.config.Parameters.resolution.ToString()
- imageSourceSelection.menuZoom50X.Click.AddHandler(fun obj args -> imageSourceSelection.txtResolution.Text <- "230000"; updateResolution ())
- imageSourceSelection.menuZoom100X.Click.AddHandler(fun obj args -> imageSourceSelection.txtResolution.Text <- "460000"; updateResolution ())
-
- imageSourceSelection.txtResolution.PreviewTextInput.AddHandler(fun obj args ->
- let text = imageSourceSelection.txtResolution.Text + args.Text
- args.Handled <- match parseAndValidatePPI text with Some _ -> false | None -> true)
-
- imageSourceSelection.imagePreview.MouseLeftButtonDown.AddHandler(fun obj args ->
- let checkbox = imageSourceSelection.chkSelection
- checkbox.IsChecked <- Nullable<bool>(not (checkbox.IsChecked.HasValue && checkbox.IsChecked.Value)))
-
- imageSourceSelection.txtResolution.LostFocus.AddHandler(fun obj args -> updateResolution ())
-
- stackImagesSourceSelection.Children.Add(imageSourceSelection) |> ignore
-
- butClose.Click.AddHandler(fun obj args -> window.Root.Close())
-
- butStart.Click.AddHandler(fun obj args ->
- let imagesToProcess = [
- for imageSelection in stackImagesSourceSelection.Children |> Seq.cast<Views.ImageSourceSelection> do
- let chk = imageSelection.chkSelection.IsChecked
- if chk.HasValue && chk.Value
- then
- let srcImg = imageSelection.Tag :?> SourceImage
- 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
- analysisPerformed <- false
- butStart.IsEnabled <- false
- butClose.Content <- "Abort"
- async {
- let results =
- ImageAnalysis.doMultipleAnalysis
- imagesToProcess
- (Some (fun progress -> window.Root.Dispatcher.Invoke(fun () -> progressBar.Value <- float progress)))
-
- lock monitor (
- fun() ->
- if not analysisCancelled
- then
- for id, cells in results do
- state.SetResult (int id) cells
-
- window.Root.Dispatcher.Invoke(fun () ->
- butStart.IsEnabled <- true
- butClose.Content <- "Close"
- updateSourceImages ())
-
- Utils.log "All analyses terminated successfully"
- atLeastOneAnalysisPerformed <- true
- analysisPerformed <- true)
- } |> Async.Start)
-
- window.Root.Loaded.AddHandler(fun obj args -> updateSourceImages ())
-
- window.Root.ShowDialog() |> ignore
-
- lock monitor (fun () ->
- if not analysisPerformed
- then
- analysisCancelled <- true
- atLeastOneAnalysisPerformed)
\ No newline at end of file
+++ /dev/null
-<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d"
- x:Name="AnalysisWindow" Height="453" Width="515" MinHeight="100" MinWidth="100" Title="Analysis" Icon="pack://application:,,,/Resources/icon.ico">
- <Grid>
- <Grid.RowDefinitions>
- <RowDefinition Height="50*"/>
- <RowDefinition Height="30"/>
- <RowDefinition Height="20*"/>
- <RowDefinition Height="Auto"/>
- </Grid.RowDefinitions>
- <ScrollViewer x:Name="scrollImagesSourceSelection" VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Hidden" Grid.Row="0" Margin="3" >
- <StackPanel x:Name="stackImagesSourceSelection" />
- </ScrollViewer>
- <ProgressBar x:Name="progress" Grid.Row="1" Margin="3" Minimum="0" Maximum="100" />
- <ScrollViewer x:Name="scrollLog" Grid.Row="2" Margin="3" HorizontalScrollBarVisibility="Auto">
- <TextBlock x:Name="textLog" />
- </ScrollViewer>
- <Grid Grid.Row="3">
- <Grid.ColumnDefinitions>
- <ColumnDefinition/>
- <ColumnDefinition/>
- </Grid.ColumnDefinitions>
- <Button x:Name="butStart" Content="Start analysis" Margin="3" Grid.Column="0"/>
- <Button x:Name="butClose" Content="Close" Margin="3" Grid.Column="1"/>
- </Grid>
- </Grid>
-</Window>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open FsXaml
-
-type AnalysisWindow = XAML<"GUI/AnalysisWindow.xaml">
-
+++ /dev/null
-module Parasitemia.GUI.Main
-
-open System
-open System.IO
-open System.Linq
-open System.Windows
-open System.Windows.Media
-open System.Windows.Markup
-open System.Windows.Shapes
-open System.Windows.Controls
-open System.Diagnostics
-open Microsoft.Win32 // For the common dialogs.
-
-open Emgu.CV.WPF
-
-open Config
-open Types
-
-let run (defaultConfig: Config) (fileToOpen: string option) =
- let app = new Application()
- let mainWindow = Views.MainWindow()
- let ctrl (name: string): 'a = mainWindow.Root.FindName(name) :?> 'a
-
- let colorRBCHealthy = Brushes.YellowGreen
- let colorRBCInfected = Brushes.Red
-
- let state = State.State()
- let mutable currentScale = 1.
- let mutable displayHealthy = false
-
- let menuExit: MenuItem = ctrl "menuExit"
- let menuSaveFile: MenuItem = ctrl "menuSave"
- let menuLoadFile: MenuItem = ctrl "menuOpen"
- let menuNewFile: MenuItem = ctrl "menuNew"
- let menuAddSourceImage: MenuItem = ctrl "menuAddSourceImage"
- let menuAnalysis: MenuItem = ctrl "menuAnalysis"
- let menuStartAnalysis: MenuItem = ctrl "menuStartAnalysis"
- let menuView: MenuItem = ctrl "menuView"
- let menuHightlightRBC: MenuItem = ctrl "menuHightlightRBC"
- let menuAbout: MenuItem = ctrl "menuAbout"
-
- let txtPatient: TextBox = ctrl "txtPatient"
- let txtGlobalParasitemia: TextBox = ctrl "txtGlobalParasitemia"
-
- let stackPreviews: StackPanel = ctrl "stackPreviews"
-
- let scrollViewCurrentImage: ScrollViewer = ctrl "scrollViewCurrentImage"
- let borderCurrentImage: Border = ctrl "borderCurrentImage"
- let canvasCurrentImage: Canvas = ctrl "canvasCurrentImage"
- let txtImageInformation: TextBlock = ctrl "txtImageInformation"
-
- let scrollRBC: ScrollViewer = ctrl "scrollRBC"
- let stackRBC: StackPanel = ctrl "stackRBC"
-
- // Initializations.
- 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 rbcWidth = rbc.size.Width
- let rbcHeight = rbc.size.Height
- let x = rbc.center.X - rbcWidth / 2. |> Utils.roundInt
- let y = rbc.center.Y - rbcHeight / 2. |> Utils.roundInt
- let w = Utils.roundInt rbcWidth
- let h = Utils.roundInt rbcHeight
- img.GetSubRect(System.Drawing.Rectangle(System.Drawing.Point((if x < 0 then 0 else x), (if y < 0 then 0 else y)),
- 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 (rbc: RBC) (frame: Views.RBCFrame) =
- frame.Opacity <- if displayHealthy || rbc.setManually || rbc.infected then 1. else 0.
- let color = if rbc.infected then colorRBCInfected else colorRBCHealthy
- frame.manuallyAdded.Visibility <- if rbc.setManually then Visibility.Visible else Visibility.Hidden
- frame.manuallyAdded.Fill <- color
- frame.border.Stroke <- color
-
- let RBCFrameFromExisting (rbc: RBC) (frame: Views.RBCFrame) : Views.RBCFrame =
- frame.Visibility <- Visibility.Visible
- frame.Height <- rbc.size.Height
- frame.Width <- rbc.size.Width
- frame.Tag <- rbc
- setRBCFrameStyle rbc frame
- frame.border.StrokeThickness <- 1.
- frame.txtRBCNumber.Text <- rbc.num.ToString()
- frame
-
- let highlightRBCFrame (frame: Views.RBCFrame) (highlight: bool) =
- let rbc = frame.Tag :?> RBC
- 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) =
- scrollViewCurrentImage.ScrollToHorizontalOffset(rbc.center.X * currentScale - scrollViewCurrentImage.ViewportWidth / 2. + borderCurrentImage.BorderThickness.Left)
- scrollViewCurrentImage.ScrollToVerticalOffset(rbc.center.Y * currentScale - scrollViewCurrentImage.ViewportHeight / 2. + borderCurrentImage.BorderThickness.Top)
-
- let parasitemiaText (nbTotal: int, nbInfected: int) : string =
- if nbTotal = 0
- then
- ""
- else
- let percent = 100. * (float nbInfected) / (float nbTotal)
- sprintf "%.1f %% (%d / %d)" percent nbInfected nbTotal
-
- let updateCurrentImageInformation () =
- match state.CurrentImage with
- | Some srcImg ->
- let parasitemiaStr = parasitemiaText (state.ImageParasitemia srcImg)
- txtImageInformation.Inlines.Clear()
- txtImageInformation.Inlines.Add(Documents.Run("Parasitemia: ", FontWeight = FontWeights.Bold))
- txtImageInformation.Inlines.Add(parasitemiaStr)
- txtImageInformation.Inlines.Add(Documents.LineBreak())
-
- txtImageInformation.Inlines.Add(Documents.Run("Average erytrocyte diameter: ", FontWeight = FontWeights.Bold))
- txtImageInformation.Inlines.Add(Documents.Run(srcImg.config.RBCRadius.ToString()))
- txtImageInformation.Inlines.Add(Documents.LineBreak())
-
- txtImageInformation.Inlines.Add(Documents.Run("Last analysis: ", FontWeight = FontWeights.Bold))
- txtImageInformation.Inlines.Add(Documents.Run(if srcImg.dateLastAnalysis.Ticks = 0L then "<Never>" else srcImg.dateLastAnalysis.ToLocalTime().ToString()))
- | _ -> ()
-
- let updateGlobalParasitemia () =
- txtGlobalParasitemia.Text <- parasitemiaText state.GlobalParasitemia
-
- let updateViewportPreview () =
- for preview in stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> do
- let srcImg = preview.Tag :?> SourceImage
- if Some srcImg = state.CurrentImage then
- preview.viewport.Visibility <- Visibility.Visible
-
- let canvasWidth = canvasCurrentImage.ActualWidth * currentScale
- let canvasHeight = canvasCurrentImage.ActualHeight * currentScale
- let previewWidth = (preview.ActualWidth - preview.BorderThickness.Left - preview.BorderThickness.Right)
- let previewHeight = (preview.ActualHeight - preview.BorderThickness.Top - preview.BorderThickness.Bottom)
-
- let marginLeft = previewWidth * (scrollViewCurrentImage.HorizontalOffset - borderCurrentImage.BorderThickness.Left) / canvasWidth - 2.
- let marginRight = previewWidth * (canvasWidth - (scrollViewCurrentImage.HorizontalOffset - borderCurrentImage.BorderThickness.Right) - scrollViewCurrentImage.ViewportWidth) / canvasWidth - 2.
- let marginTop = previewHeight * (scrollViewCurrentImage.VerticalOffset - borderCurrentImage.BorderThickness.Top) / canvasHeight - 2.
- let marginBottom = previewHeight * (canvasHeight - (scrollViewCurrentImage.VerticalOffset - borderCurrentImage.BorderThickness.Bottom) - scrollViewCurrentImage.ViewportHeight) / canvasHeight - 2.
-
- preview.viewport.Margin <-
- Thickness(
- marginLeft,
- marginTop,
- marginRight,
- marginBottom)
- else
- preview.viewport.Visibility <- Visibility.Hidden
-
- let rec setAsInfected (rbc: RBC) (infected: bool) =
- state.SetAsInfected rbc infected
- canvasCurrentImage.Children
- |> Seq.cast<Views.RBCFrame>
- |> Seq.iter
- (fun frame ->
- if (frame.Tag :?> RBC) = rbc
- then
- setRBCFrameStyle rbc frame)
- updateRBCFramesPreview ()
- updateCurrentImageInformation ()
- updateGlobalParasitemia ()
-
- and RBCFrame (rbc: RBC) : Views.RBCFrame =
- let frame = RBCFrameFromExisting rbc (Views.RBCFrame())
- frame.SetValue(Panel.ZIndexProperty, Int32.MaxValue - rbc.num) // To be sure the
- frame.menuRBCSetAsHealthy.Click.AddHandler(fun obj args -> setAsInfected (frame.Tag :?> RBC) false)
- frame.menuRBCSetAsInfected.Click.AddHandler(fun obj args -> setAsInfected (frame.Tag :?> RBC) true)
- frame.ContextMenuOpening.AddHandler(
- fun obj args ->
- 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.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)
- frame
-
- and updateRBCFramesPreview () =
- match state.CurrentImage with
- | Some srcImg ->
- let mutable currentPreview = 0
- for rbc in srcImg.rbcs |> List.filter (fun rbc -> displayHealthy || rbc.infected) do
- let previewInfected =
- if currentPreview < stackRBC.Children.Count
- then
- RBCFrameFromExisting rbc (stackRBC.Children.[currentPreview] :?> Views.RBCFrame)
- else
- let f = RBCFrame rbc
- f.MouseLeftButtonUp.AddHandler(fun obj args -> zoomToRBC (f.Tag :?> RBC))
- stackRBC.Children.Add(f) |> ignore
- f
-
- currentPreview <- currentPreview + 1
-
- previewInfected.Height <- stackRBC.ActualHeight
- previewInfected.Width <- stackRBC.ActualHeight * rbc.size.Width / rbc.size.Height
- previewInfected.border.Fill <- ImageBrush(BitmapSourceConvert.ToBitmapSource(extractRBCPreview srcImg.img rbc))
-
- stackRBC.Children.RemoveRange(currentPreview, stackRBC.Children.Count - currentPreview)
- | _ -> ()
-
- updateViewportPreview ()
-
- let updateRBCFramesCurrent () =
- match state.CurrentImage with
- | Some srcImg ->
- let mutable currentCanvas = 0
- for rbc in srcImg.rbcs do
- let frame =
- if currentCanvas < canvasCurrentImage.Children.Count
- then
- RBCFrameFromExisting rbc (canvasCurrentImage.Children.[currentCanvas] :?> Views.RBCFrame)
- else
- let f = RBCFrame rbc
- f.Root.Opacity <- 0.7
- canvasCurrentImage.Children.Add(f) |> ignore
- f
-
- currentCanvas <- currentCanvas + 1
-
- Canvas.SetLeft(frame, rbc.center.X - rbc.size.Width / 2.)
- Canvas.SetTop(frame, rbc.center.Y - rbc.size.Height / 2.)
-
- for i in currentCanvas .. canvasCurrentImage.Children.Count - 1 do
- canvasCurrentImage.Children.[i].Visibility <- Visibility.Hidden
- | _ -> ()
-
- let saveCurrentDocument () =
- if state.FilePath = ""
- then
- let dialog = SaveFileDialog(AddExtension = true, DefaultExt = PiaZ.extension, Filter = PiaZ.filter);
- let res = dialog.ShowDialog()
- if res.HasValue && res.Value
- then
- state.FilePath <- dialog.FileName
- state.Save()
- else
- state.Save()
-
- // Ask the use to save the current document if neccessary.
- let askSaveCurrent () =
- 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 ()
- | _ -> ()
-
- let updateCurrentImage () =
- match state.CurrentImage with
- | Some srcImg ->
- // Highlight the preview.
- stackPreviews.Children
- |> Seq.cast<Views.ImageSourcePreview>
- |> Seq.iter (fun preview -> preview.border.BorderThickness <- Thickness(if preview.Tag = (srcImg :> Object) then 3. else 0.))
-
- canvasCurrentImage.Height <- float srcImg.img.Height
- canvasCurrentImage.Width <- float srcImg.img.Width
- canvasCurrentImage.Background <- ImageBrush(BitmapSourceConvert.ToBitmapSource(srcImg.img))
-
- updateRBCFramesCurrent ()
- updateRBCFramesPreview ()
- updateCurrentImageInformation ()
- | None ->
- stackRBC.Children.Clear()
- canvasCurrentImage.Children.Clear()
- canvasCurrentImage.Background <- Brushes.Black
-
- let setCurrentImage (srcImg: SourceImage) =
- if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg
- then
- state.CurrentImage <- Some srcImg
- updateCurrentImage ()
-
- let addPreview (srcImg: SourceImage) =
- let imgCtrl = Views.ImageSourcePreview(Margin = Thickness(3.))
-
- imgCtrl.menuRemoveImage.Click.AddHandler(fun obj args ->
- stackPreviews.Children.Remove(imgCtrl)
- let srcImg = imgCtrl.Tag :?> SourceImage
- let currentRemoved = Some srcImg = state.CurrentImage
- state.RemoveSourceImage srcImg
- if currentRemoved
- then
- updateCurrentImage()
- stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> |> Seq.iter (fun imgPreview -> imgPreview.txtImageNumber.Text <- (imgPreview.Tag :?> SourceImage).num.ToString()))
-
- imgCtrl.Tag <- srcImg
- imgCtrl.txtImageNumber.Text <- srcImg.num.ToString()
- let width = 200
- let height = srcImg.img.Height * width / srcImg.img.Width
- imgCtrl.imagePreview.Source <- BitmapSourceConvert.ToBitmapSource(srcImg.img.Resize(width, height, Emgu.CV.CvEnum.Inter.Cubic))
- stackPreviews.Children.Add(imgCtrl) |> ignore
-
- // Zoom to a mouse position into the control 'imgCtrl'.
- let zoomTo (mousePos: Point) =
- let canvasW = canvasCurrentImage.ActualWidth * currentScale
- let canvasH = canvasCurrentImage.ActualHeight * currentScale
- let centerX = (mousePos.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
- let centerY = (mousePos.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
- scrollViewCurrentImage.ScrollToHorizontalOffset(centerX - scrollViewCurrentImage.ViewportWidth / 2. + borderCurrentImage.BorderThickness.Left)
- scrollViewCurrentImage.ScrollToVerticalOffset(centerY - scrollViewCurrentImage.ViewportHeight / 2. + borderCurrentImage.BorderThickness.Top)
-
- imgCtrl.MouseLeftButtonDown.AddHandler(fun obj args ->
- setCurrentImage (state.SourceImages |> Seq.find (fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
- imgCtrl.UpdateLayout()
- zoomTo (args.GetPosition(imgCtrl))
- imgCtrl.CaptureMouse() |> ignore)
-
- imgCtrl.MouseMove.AddHandler(fun obj args ->
- if imgCtrl.IsMouseCaptured
- then
- zoomTo (args.GetPosition(imgCtrl)))
-
- imgCtrl.MouseLeftButtonUp.AddHandler(fun obj args ->
- if imgCtrl.IsMouseCaptured
- then
- imgCtrl.ReleaseMouseCapture())
-
- let updatePreviews () =
- stackPreviews.Children.Clear ()
- for srcImg in state.SourceImages do
- addPreview srcImg
- updateCurrentImage ()
-
- let updateGUI () =
- txtPatient.Text <- state.PatientID
- updatePreviews ()
- updateGlobalParasitemia ()
-
- let loadFile (filepath: string) =
- askSaveCurrent ()
- state.FilePath <- filepath
- state.Load()
- updateGUI ()
-
- txtPatient.LostFocus.AddHandler(fun obj args -> state.PatientID <- txtPatient.Text)
-
- menuExit.Click.AddHandler(fun obj args ->
- askSaveCurrent ()
- mainWindow.Root.Close())
-
- menuSaveFile.Click.AddHandler(fun obj args -> saveCurrentDocument ())
-
- menuLoadFile.Click.AddHandler(fun obj args ->
- // TODO: if current state not saved and not empty, ask to save it.
- let dialog = OpenFileDialog(Filter = PiaZ.filter)
- let res = dialog.ShowDialog()
- if res.HasValue && res.Value
- then loadFile dialog.FileName)
-
- menuNewFile.Click.AddHandler(fun obj args ->
- askSaveCurrent ()
- state.Reset()
- updateGUI())
-
- menuAddSourceImage.Click.AddHandler(fun obj args ->
- let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
- let res = dialog.ShowDialog()
- if res.HasValue && res.Value
- then
- let noSourceImage = state.SourceImages.Count() = 0
-
- for filename in dialog.FileNames do
- let srcImg = state.AddSourceImage filename defaultConfig
- addPreview srcImg
-
- updateGlobalParasitemia ()
-
- if noSourceImage
- then
- updateCurrentImage ())
-
- menuAnalysis.SubmenuOpened.AddHandler(fun obj args -> menuStartAnalysis.IsEnabled <- state.SourceImages.Count() > 0)
-
- menuStartAnalysis.Click.AddHandler(fun obj args ->
- if Analysis.showWindow mainWindow.Root state
- then
- updateGlobalParasitemia ()
- updateCurrentImage ())
-
- menuHightlightRBC.Click.AddHandler(fun obj args ->
- displayHealthy <- menuHightlightRBC.IsChecked
- updateRBCFramesPreview ()
- updateRBCFramesCurrent ())
-
- menuAbout.Click.AddHandler(fun obj args -> About.showWindow mainWindow.Root)
-
- // Zoom on the current image.
- let adjustCurrentImageBorders (deltaX: float) (deltaY: float) =
- borderCurrentImage.BorderThickness <-
- Thickness(
- (scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
- (scrollViewCurrentImage.ViewportHeight + deltaY) / 2.,
- (scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
- (scrollViewCurrentImage.ViewportHeight + deltaY) / 2.)
-
- 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
- adjustCurrentImageBorders 0.0 0.0
- // Center the view at the center of the image initialy.
- scrollViewCurrentImage.UpdateLayout()
- scrollViewCurrentImage.ScrollToHorizontalOffset(borderCurrentImage.ActualWidth / 2. - scrollViewCurrentImage.ViewportWidth / 2.)
- scrollViewCurrentImage.ScrollToVerticalOffset(borderCurrentImage.ActualHeight / 2. - scrollViewCurrentImage.ViewportHeight / 2.))
-
- 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
- scrollViewCurrentImage.ScrollToHorizontalOffset(scrollViewCurrentImage.HorizontalOffset + deltaX / 8.)
- scrollViewCurrentImage.ScrollToVerticalOffset(scrollViewCurrentImage.VerticalOffset + deltaY / 8.))
-
- let mutable maxScale = 4.
- let mutable minScale = 0.25
- let currentImageScaleTransform = ScaleTransform()
- canvasCurrentImage.LayoutTransform <- currentImageScaleTransform
- 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
- let previousScale = currentScale
- currentScale <-
- let newScale = currentScale * scaleFactor
- if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
- let realScaleFactor = currentScale / previousScale
-
- let centerX = scrollViewCurrentImage.HorizontalOffset + scrollViewCurrentImage.ViewportWidth / 2. - borderCurrentImage.BorderThickness.Left
- let centerY = scrollViewCurrentImage.VerticalOffset + scrollViewCurrentImage.ViewportHeight / 2. - borderCurrentImage.BorderThickness.Top
-
- currentImageScaleTransform.ScaleX <- currentScale
- currentImageScaleTransform.ScaleY <- currentScale
-
- scrollViewCurrentImage.ScrollToHorizontalOffset(centerX * realScaleFactor - scrollViewCurrentImage.ViewportWidth / 2. + borderCurrentImage.BorderThickness.Left)
- scrollViewCurrentImage.ScrollToVerticalOffset(centerY * realScaleFactor - scrollViewCurrentImage.ViewportHeight / 2. + borderCurrentImage.BorderThickness.Top)
-
- args.Handled <- true)
-
- // Pan on the current image.
- let mutable scrollStartPosition = Point(0., 0.)
- let mutable scrollStartOffsetX = 0.
- let mutable scrollStartOffsetY = 0.
- borderCurrentImage.PreviewMouseLeftButtonDown.AddHandler(fun obj args ->
- scrollStartPosition <- args.GetPosition(scrollViewCurrentImage)
- scrollStartOffsetX <- scrollViewCurrentImage.HorizontalOffset
- scrollStartOffsetY <- scrollViewCurrentImage.VerticalOffset
- borderCurrentImage.Cursor <- Input.Cursors.ScrollAll
- borderCurrentImage.CaptureMouse() |> ignore
- args.Handled <- true)
-
- borderCurrentImage.PreviewMouseMove.AddHandler(fun obj args ->
- if borderCurrentImage.IsMouseCaptured
- then
- let position = args.GetPosition(scrollViewCurrentImage)
- let deltaX = scrollStartPosition.X - position.X
- let deltaY = scrollStartPosition.Y - position.Y
- scrollViewCurrentImage.ScrollToHorizontalOffset(deltaX + scrollStartOffsetX)
- scrollViewCurrentImage.ScrollToVerticalOffset(deltaY + scrollStartOffsetY)
-
- args.Handled <- true)
-
- borderCurrentImage.PreviewMouseLeftButtonUp.AddHandler(fun obj args ->
- if borderCurrentImage.IsMouseCaptured
- then
- borderCurrentImage.Cursor <- Input.Cursors.Arrow
- borderCurrentImage.ReleaseMouseCapture()
- args.Handled <- true)
-
- // Viewport preview.
- scrollViewCurrentImage.ScrollChanged.AddHandler(fun obj args -> updateViewportPreview ())
-
- mainWindow.Root.Show()
-
- match fileToOpen with
- | Some filepath -> loadFile filepath
- | None -> ()
-
- app.Run()
\ No newline at end of file
+++ /dev/null
-<UserControl
- xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:fsxaml="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d" d:DesignWidth="119.223" d:DesignHeight="84.911"
- >
- <Border x:Name="border" ClipToBounds="True" BorderBrush="{DynamicResource {x:Static SystemColors.HighlightBrushKey}}">
- <Grid x:Name="grid">
- <Grid.ContextMenu>
- <ContextMenu>
- <MenuItem x:Name="menuRemoveImage" Header="_Remove image" />
- </ContextMenu>
- </Grid.ContextMenu>
- <Image x:Name="imagePreview" />
- <Border HorizontalAlignment="Right" VerticalAlignment="Bottom" Background="#4C000000" Margin="0,0,3,3" CornerRadius="5" >
- <TextBlock x:Name="txtImageNumber" Padding="2" Text="42" Foreground="White" />
- </Border>
- <Rectangle x:Name="viewport" Margin="24,30,71,26" Stroke="#BFFFFF00" RenderTransformOrigin="0.5,0.5" Visibility="Hidden"/>
- </Grid>
- </Border>
-</UserControl>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open System
-open System.Windows
-open System.Windows.Data
-open System.Windows.Input
-
-open FSharp.ViewModule
-open FsXaml
-
-type ImageSourcePreview = XAML<"GUI/ImageSourcePreview.xaml", true>
-
-(* type ImageSourcePreviewController() =
- inherit UserControlViewController<ImageSourcePreview>() *)
-
-(* type ImageSourcePreviewViewModel() =
- inherit ViewModelBase() *)
+++ /dev/null
-<UserControl
- xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:fsxaml="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d" d:DesignWidth="349.723" d:DesignHeight="118.911"
- >
- <UserControl.Background>
- <SolidColorBrush Color="{DynamicResource {x:Static SystemColors.ControlColorKey}}"/>
- </UserControl.Background>
- <Grid x:Name="gridMain">
- <Grid.ColumnDefinitions>
- <ColumnDefinition Width="100"/>
- <ColumnDefinition/>
- </Grid.ColumnDefinitions>
- <Grid x:Name="gridImage" Grid.ColumnSpan="1" VerticalAlignment="Top">
- <Image x:Name="imagePreview" />
- <CheckBox x:Name="chkSelection" HorizontalAlignment="Left" VerticalAlignment="Top" Margin="3,3,0,0"/>
- <Border HorizontalAlignment="Right" VerticalAlignment="Bottom" Background="#4C000000" Margin="0,0,3,3" CornerRadius="5" >
- <TextBlock x:Name="txtImageNumber" Padding="2" Text="42" Foreground="White" />
- </Border>
- <Rectangle x:Name="viewport" Margin="24,30,71,26" Stroke="#BFFFFF00" RenderTransformOrigin="0.5,0.5" Visibility="Hidden"/>
- </Grid>
- <Grid Grid.Column="1">
- <Grid.ColumnDefinitions>
- <ColumnDefinition Width="Auto"/>
- <ColumnDefinition/>
- </Grid.ColumnDefinitions>
- <Grid.RowDefinitions>
- <RowDefinition Height="Auto"/>
- <RowDefinition Height="Auto"/>
- <RowDefinition Height="1*"/>
- </Grid.RowDefinitions>
- <Label Content="Last analysis" Grid.Column="0" Grid.Row="0" Margin="10,0,3,0" />
- <Label Content="Resolution [PPI]" Grid.Column="0" Grid.Row="1" Margin="10,0,3,0" />
- <Label x:Name="lblDateLastAnalysis" Grid.Column="1" Margin="3,0,3,0"/>
- <Grid Grid.Column="1" Grid.Row="1">
- <Grid.ColumnDefinitions>
- <ColumnDefinition/>
- <ColumnDefinition Width="Auto"/>
- </Grid.ColumnDefinitions>
- <TextBox x:Name="txtResolution" Margin="3" Text="" Grid.Column="0" />
- <Button x:Name="butDefaultResolutions" Content="Defaults" Grid.Column="1" Margin="3">
- <Button.ContextMenu>
- <ContextMenu>
- <MenuItem x:Name="menuZoom50X" Header="_230'000 PPI (50X)" />
- <MenuItem x:Name="menuZoom100X" Header="_460'000 PPI (100X)" />
- </ContextMenu>
- </Button.ContextMenu>
- <Button.Style>
- <Style TargetType="{x:Type Button}">
- <Style.Triggers>
- <EventTrigger RoutedEvent="Click">
- <EventTrigger.Actions>
- <BeginStoryboard>
- <Storyboard>
- <BooleanAnimationUsingKeyFrames Storyboard.TargetProperty="ContextMenu.IsOpen">
- <DiscreteBooleanKeyFrame KeyTime="0:0:0" Value="True"/>
- </BooleanAnimationUsingKeyFrames>
- </Storyboard>
- </BeginStoryboard>
- </EventTrigger.Actions>
- </EventTrigger>
- </Style.Triggers>
- </Style>
- </Button.Style>
- </Button>
- </Grid>
- </Grid>
- </Grid>
-</UserControl>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open System
-open System.Windows
-open System.Windows.Data
-open System.Windows.Input
-
-open FSharp.ViewModule
-open FsXaml
-
-type ImageSourceSelection = XAML<"GUI/ImageSourceSelection.xaml", true>
-
-(* type ImageSourcePreviewController() =
- inherit UserControlViewController<ImageSourcePreview>() *)
-
-(* type ImageSourcePreviewViewModel() =
- inherit ViewModelBase() *)
+++ /dev/null
-<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d"
- x:Name="MainWindow" Height="681.888" Width="787.61" MinHeight="200" MinWidth="300" Title="Parasitemia" Icon="pack://application:,,,/Resources/icon.ico">
- <DockPanel x:Name="dockPanelMain" LastChildFill="True">
- <Menu DockPanel.Dock="Top">
- <MenuItem Header="_File">
- <MenuItem x:Name="menuNew" Header="_New" />
- <MenuItem x:Name="menuOpen" Header="_Open" />
- <MenuItem x:Name="menuSave" Header="_Save" />
- <Separator />
- <MenuItem x:Name="menuExit" Header="_Exit" />
- </MenuItem>
- <MenuItem Header="_Images">
- <MenuItem x:Name="menuAddSourceImage" Header="_Add a source image" />
- </MenuItem>
- <MenuItem x:Name="menuAnalysis" Header="_Analysis">
- <MenuItem x:Name="menuStartAnalysis" Header="_Show analysis window" />
- </MenuItem>
- <MenuItem x:Name="menuView" Header="_View">
- <MenuItem x:Name="menuHightlightRBC" Header="_Highlight healthy erytrocytes" IsCheckable="True" />
- </MenuItem>
- <MenuItem x:Name="menuHelp" Header="_Help">
- <MenuItem x:Name="menuAbout" Header="_About" />
- </MenuItem>
- </Menu>
- <Grid x:Name="gridMain">
- <Grid.RowDefinitions>
- <RowDefinition Height="Auto"/>
- <RowDefinition/>
- </Grid.RowDefinitions>
- <Grid.ColumnDefinitions>
- <ColumnDefinition Width="180"/>
- <ColumnDefinition/>
- </Grid.ColumnDefinitions>
- <Grid x:Name="gridGlobalInfo" Grid.ColumnSpan="2" Margin="3,3,3,3" >
- <Grid.ColumnDefinitions>
- <ColumnDefinition Width="101"/>
- <ColumnDefinition Width="21"/>
- <ColumnDefinition/>
- </Grid.ColumnDefinitions>
- <Grid.RowDefinitions>
- <RowDefinition Height="Auto"/>
- <RowDefinition Height="Auto"/>
- </Grid.RowDefinitions>
- <Label x:Name="lblPatient" Margin="10,0,3,0 " Content="Patient ID" Grid.ColumnSpan="2"/>
- <Label x:Name="lblGlobalParasitemia" Margin="10,0,3,0" Content="Global parasitemia" Grid.Row="1" Grid.ColumnSpan="2" />
- <TextBox x:Name="txtPatient" Grid.Column="2" Margin="3,4,10,4" TextWrapping="Wrap" VerticalAlignment="Center" />
- <TextBox x:Name="txtGlobalParasitemia" Grid.Column="2" Grid.Row="1" Margin="3,4,10,4" TextWrapping="Wrap" VerticalAlignment="Center" IsReadOnly="True" />
- </Grid>
- <Border BorderBrush="Black" BorderThickness="1" Margin="3" Grid.Row="1" >
- <ScrollViewer x:Name="scrollPreviews" VerticalScrollBarVisibility="Auto" >
- <StackPanel x:Name="stackPreviews" />
- </ScrollViewer>
- </Border>
- <Grid Grid.Column="2" Grid.Row="2">
- <Grid.RowDefinitions>
- <RowDefinition Height="100"/>
- <RowDefinition/>
- <RowDefinition Height="Auto"/>
- </Grid.RowDefinitions>
- <ScrollViewer x:Name="scrollViewCurrentImage" Grid.Row="1" VerticalScrollBarVisibility="Visible" HorizontalScrollBarVisibility="Visible" Background="Black" MinHeight="100" MinWidth="100">
- <Border x:Name="borderCurrentImage" BorderBrush="Transparent">
- <Canvas x:Name="canvasCurrentImage" Height="100" Width="100" />
- </Border>
- </ScrollViewer>
- <ScrollViewer x:Name="scrollRBC" VerticalScrollBarVisibility="Hidden" HorizontalScrollBarVisibility="Visible" Grid.RowSpan="1" Margin="3">
- <StackPanel x:Name="stackRBC" Orientation="Horizontal" />
- </ScrollViewer>
- <TextBlock x:Name="txtImageInformation" Grid.Row="2" TextWrapping="Wrap" Margin="3" />
- </Grid>
- </Grid>
- </DockPanel>
-</Window>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open FsXaml
-
-type MainWindow = XAML<"GUI/MainWindow.xaml">
-
+++ /dev/null
-<UserControl
- xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d" d:DesignWidth="259.5" d:DesignHeight="45.5"
- >
- <Grid>
- <Grid.RowDefinitions>
- <RowDefinition />
- <RowDefinition />
- </Grid.RowDefinitions>
- <Grid.ColumnDefinitions>
- <ColumnDefinition Width="*" />
- <ColumnDefinition Width="Auto" />
- </Grid.ColumnDefinitions>
- <Button x:Name="upButton" Grid.Column="1" Content="^"/>
- <Button x:Name="downButton" Grid.Column="1" Grid.Row="1" Content="v"/>
- <TextBox x:Name="input" Grid.RowSpan="2" />
- </Grid>
-</UserControl>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open System
-open System.Windows
-open System.Windows.Data
-open System.Windows.Input
-
-open FsXaml
-
-type NumericUpDown = XAML<"GUI/NumericUpDown.xaml", true>
-
-type NumericUpDownEvents = Up | Down
-
-type NumericUpDownController() =
- inherit UserControlViewController<NumericUpDown>()
-
-
+++ /dev/null
-// ParasitemIA Zipped file format.
-module Parasitemia.GUI.PiaZ
-
-open System
-open System.Windows
-open System.IO
-open System.IO.Compression
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Newtonsoft.Json
-open Newtonsoft.Json.Converters
-
-open Types
-
-let extension = ".piaz"
-let filter = "PIA|*.piaz"
-
-// Information associated to a document.
-type JSONInformation = {
- patientID: string
-}
-
-// Information associated to each images.
-type JSONSourceImage = {
- num: int
- RBCRadius: float32 // The RBC Radius found by granulometry.
- parameters: Config.Parameters
- dateLastAnalysis: DateTime
- rbcs: RBC List
-}
-
-type FileData = {
- patientID: string
- images: SourceImage list
-}
-
-let mainEntryName = "info.json"
-let imageExtension = ".tiff"
-
-let save (filePath: string) (data: FileData) =
- use file = ZipFile.Open(filePath, ZipArchiveMode.Update)
-
- for e in List.ofSeq file.Entries do // 'ofSeq' to not iterate a collection currently modified.
- e.Delete()
-
- // Main JSON file.
- let mainEntry = file.CreateEntry(mainEntryName, CompressionLevel.Fastest)
- use mainEntryWriter = new StreamWriter(mainEntry.Open())
- mainEntryWriter.Write(JsonConvert.SerializeObject({ JSONInformation.patientID = data.patientID }))
-
- // Write each images and the associated information.
- for srcImg in data.images do
- let imgFilename = (string srcImg.num) + imageExtension
- let imgEntry = file.CreateEntry(imgFilename, CompressionLevel.NoCompression) // FIXME: It seems a compression is applied to this file despite of the 'NoCompression' flag.
- srcImg.img.ToBitmap().Save(imgEntry.Open(), System.Drawing.Imaging.ImageFormat.Tiff)
-
- let imgJSONEntry = file.CreateEntry(imgFilename + ".json", CompressionLevel.Fastest)
- use imgJSONFileWriter = new StreamWriter(imgJSONEntry.Open())
- imgJSONFileWriter.Write(JsonConvert.SerializeObject({ num = srcImg.num; RBCRadius = srcImg.config.RBCRadius.Pixel; parameters = srcImg.config.Parameters; dateLastAnalysis = srcImg.dateLastAnalysis; rbcs = srcImg.rbcs }))
-
-
-let load (filePath: string) : FileData =
- use file = ZipFile.Open(filePath, ZipArchiveMode.Read)
-
- let mainEntry = file.GetEntry(mainEntryName)
- use mainEntryReader = new StreamReader(mainEntry.Open())
- let info = JsonConvert.DeserializeObject<JSONInformation>(mainEntryReader.ReadToEnd())
-
- { patientID = info.patientID
- images = [ let mutable imgNum = 0
- for imgEntry in file.Entries do
- if imgEntry.Name.EndsWith(imageExtension)
- then
- let img = new Image<Bgr, byte>(new System.Drawing.Bitmap(imgEntry.Open(), false)) // FIXME: Should we dispose the bitmap?
- imgNum <- imgNum + 1
- let imgEntry = file.GetEntry(imgEntry.Name + ".json")
- use imgEntryFileReader = new StreamReader(imgEntry.Open())
- let imgInfo = JsonConvert.DeserializeObject<JSONSourceImage>(imgEntryFileReader.ReadToEnd())
- let config = Config.Config(imgInfo.parameters)
- config.SetRBCRadius imgInfo.RBCRadius
- yield { num = imgNum
- config = config
- dateLastAnalysis = imgInfo.dateLastAnalysis
- img = img
- rbcs = imgInfo.rbcs } ] }
\ No newline at end of file
+++ /dev/null
-<UserControl
- xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
- xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
- xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
- xmlns:fsxaml="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
- xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
- mc:Ignorable="d" d:DesignWidth="100" d:DesignHeight="100"
- >
- <Grid x:Name="grid">
- <Grid.ContextMenu>
- <ContextMenu>
- <MenuItem x:Name="menuRBCSetAsHealthy" Header="_Set as healthy" />
- <MenuItem x:Name="menuRBCSetAsInfected" Header="_Set as infected" />
- </ContextMenu>
- </Grid.ContextMenu>
- <Rectangle x:Name="border" Fill="#00000000" />
- <Polygon x:Name="manuallyAdded" Points="0,0 12,0, 12,12" Fill="Black" HorizontalAlignment="Right" VerticalAlignment="Top" />
- <Border HorizontalAlignment="Right" VerticalAlignment="Bottom" Margin="0,0,3,3" Background="#66000000" CornerRadius="5">
- <TextBlock x:Name="txtRBCNumber" Padding="2" Text="42" Foreground="White" />
- </Border>
- </Grid>
-</UserControl>
\ No newline at end of file
+++ /dev/null
-namespace Parasitemia.GUI.Views
-
-open System
-open System.Windows
-open System.Windows.Data
-open System.Windows.Input
-
-open FSharp.ViewModule
-open FsXaml
-
-type RBCFrame = XAML<"GUI/RBCFrame.xaml", true>
+++ /dev/null
-module Parasitemia.GUI.State
-
-open System
-open System.Collections.Generic
-open System.Windows
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Types
-
-type State () =
- 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 this.PatientID
- with get () : string = patientID
- and set id =
- if id <> patientID
- then
- alteredSinceLastSave <- true
- patientID <- id
-
- 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.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
- alteredSinceLastSave <- true
- rbc.infected <- infected
- rbc.setManually <- not rbc.setManually
-
- member this.Save () =
- let data = { PiaZ.FileData.patientID = this.PatientID; PiaZ.FileData.images = List.ofSeq sourceImages }
- PiaZ.save this.FilePath data
- alteredSinceLastSave <- false
-
- member this.Load () =
- let data = PiaZ.load this.FilePath
- this.PatientID <- data.patientID
- sourceImages.Clear()
- sourceImages.InsertRange(0, data.images)
- if sourceImages.Count > 0
- then this.CurrentImage <- Some sourceImages.[0]
- alteredSinceLastSave <- false
-
- member this.AddSourceImage (filePath: string) (defaultConfig: Config.Config) : SourceImage =
- let srcImg = { num = sourceImages.Count + 1; config = defaultConfig.Copy(); dateLastAnalysis = DateTime(0L); rbcs = []; img = new Image<Bgr, byte>(filePath) }
- sourceImages.Add(srcImg)
- if sourceImages.Count = 1
- then this.CurrentImage <- Some sourceImages.[0]
- alteredSinceLastSave <- true
- srcImg
-
- member this.RemoveSourceImage (srcImg: SourceImage) =
- let isCurrent =
- match this.CurrentImage with
- | Some srcImg' -> srcImg = srcImg'
- | _ -> false
-
- if sourceImages.Remove(srcImg)
- then
- alteredSinceLastSave <- true
- 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.SetResult (imgNum: int) (cells: Cell list) =
- let sourceImage = sourceImages.Find(fun srcImg -> srcImg.num = imgNum)
-
- let w = sourceImage.img.Width
- let h = sourceImage.img.Height
-
- sourceImage.dateLastAnalysis <- DateTime.UtcNow
-
- // 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 getPreviousRBC (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
- |> List.filter (fun cell -> match cell.cellClass with HealthyRBC | InfectedRBC -> true | _ -> false )
- |> List.sortByDescending (fun cell -> cell.infectedArea, (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 =
- match getPreviousRBC center with
- | Some rbc -> rbc.infected, true
- | _ -> cell.cellClass = InfectedRBC, false
-
- { num = i + 1
- infected = infected
- setManually = setManually
- center = center
- size = Size(float cell.elements.Width, float cell.elements.Height)
- infectedArea = cell.infectedArea })
-
- alteredSinceLastSave <- true
-
- member this.SourceImages : SourceImage seq =
- sourceImages :> SourceImage seq
-
- member this.Reset () =
- this.PatientID <- ""
- this.FilePath <- ""
- this.CurrentImage <- None
- sourceImages.Clear()
- alteredSinceLastSave <- false
\ No newline at end of file
+++ /dev/null
-module Parasitemia.GUI.Types
-
-open System
-open System.Windows
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-type RBC = {
- num: int
-
- mutable infected: bool
- mutable setManually: bool
-
- center: Point
- size: Size
- infectedArea: int }
-
-type SourceImage = {
- mutable num: int
- mutable config: Config.Config
- mutable dateLastAnalysis: DateTime // UTC.
- img: Image<Bgr, byte>
- mutable rbcs: RBC list }
\ No newline at end of file
+++ /dev/null
-module Granulometry
-
-open System
-open System.Drawing
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Utils
-
-// 'range': a minimum and maximum radius.
-// 'scale': <= 1.0, to speed up the process.
-let findRadiusByClosing (img: Image<Gray, 'TDepth>) (range: int * int) (scale: float) : int =
- use scaledImg = if scale = 1. then img else img.Resize(scale, CvEnum.Inter.Area)
-
- let r1, r2 = range
- let r1', r2' = roundInt (float r1 * scale), roundInt (float r2 * scale)
-
- let patternSpectrum = Array.zeroCreate (r2' - r1')
- let intensityImg = scaledImg.GetSum().Intensity
-
- // 's' must be odd.
- 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 in 0 .. r - 1 do
- for j in 0 .. r - 1 do
- if i + j < r
- then
- m.[i, j] <- 0uy
- m.[s - i - 1, j] <- 0uy
- m.[i, s - j - 1] <- 0uy
- m.[s - i - 1, s - j - 1] <- 0uy
- m
-
- let mutable previous_n = Double.NaN
- for r in r1' .. r2' do
- let se = CvInvoke.GetStructuringElement(CvEnum.ElementShape.Ellipse, Size(2 * r, 2 * r), Point(-1, -1))
- //let se = octagon (2 * r - 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
- patternSpectrum.[r - r1' - 1] <- abs (n - previous_n)
- previous_n <- n
-
- let max, _ = patternSpectrum |> Array.indexed |> Array.fold (fun (iMax, sMax) (i, s) -> if s > sMax then (i, s) else (iMax, sMax)) (0, Double.MinValue)
-
- float (max + r1') / scale |> roundInt
-
-let findRadiusByAreaClosing (img: Image<Gray, float32>) (range: int * int) : int =
- let r1, r2 = range
-
- use imgCopy = img.Copy()
-
- let mutable maxDiff = 0.f
- let mutable max_r = r1
-
- ImgTools.areaCloseFWithFun imgCopy [ for r in r1 .. r2 -> Math.PI * float r ** 2. |> roundInt, r ] (fun r diff ->
- if r <> r1 && diff > maxDiff
- then
- maxDiff <- diff
- max_r <- r - 1 )
- max_r
-
+++ /dev/null
-module Heap
-
-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)
-
-[<Struct>]
-type private Node<'k, '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
-
-type Heap<'k, 'v> (kComparer : IComparer<'k>) =
- let a = List<Node<'k, 'v>>()
-
- 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
- max <- r
-
- // If a child is greater than the parent.
- 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 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
- else
- true
- let rightIntegrity =
- if r < a.Count
- then
- if kComparer.Compare(a.[r].key, a.[i].key) > 0
- then false
- else checkIntegrity r
- else
- true
- leftIntegrity && rightIntegrity
-
- interface IEnumerable<'k * 'v> with
- member this.GetEnumerator () : IEnumerator<'k * 'v> =
- (seq { for e in a -> e.key, e.value }).GetEnumerator()
-
- interface System.Collections.IEnumerable with
- member this.GetEnumerator () : System.Collections.IEnumerator =
- (this :> IEnumerable<'k * 'v>).GetEnumerator() :> System.Collections.IEnumerator
-
- member this.Next () : 'k * 'v =
- let node = a.[0]
- a.[0] <- a.[a.Count - 1]
- a.RemoveAt(a.Count - 1)
- heapUp 0
- node.key, node.value
-
- member this.RemoveNext () =
- a.[0] <- a.[a.Count - 1]
- a.RemoveAt(a.Count - 1)
- heapUp 0
-
- member this.Add (key: 'k) (value: 'v) =
- a.Add(Node(key, value))
-
- let mutable i = a.Count - 1
- while i > 0 && kComparer.Compare(a.[parent i].key, a.[i].key) < 0 do
- let tmp = a.[parent i]
- a.[parent i] <- a.[i]
- a.[i] <- tmp
- i <- parent i
-
- member this.IsEmpty = a.Count = 0
- member this.Count = a.Count
-
- member this.Max : 'k * 'v =
- let max = a.[0]
- max.key, max.value
-
- member this.Clear () = a.Clear()
-
-
+++ /dev/null
-module ImgTools
-
-open System
-open System.Drawing
-open System.Collections.Generic
-open System.Linq
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Heap
-open Const
-open Utils
-
-// Normalize image values between 0uy and 255uy.
-let normalizeAndConvert (img: Image<Gray, 'TDepth>) : Image<Gray, byte> =
- let min = ref [| 0.0 |]
- let minLocation = ref <| [| Point() |]
- let max = ref [| 0.0 |]
- let maxLocation = ref <| [| Point() |]
- img.MinMax(min, max, minLocation, maxLocation)
- ((img.Convert<Gray, float32>() - (!min).[0]) / ((!max).[0] - (!min).[0]) * 255.0).Convert<Gray, byte>()
-
-
-let saveImg (img: Image<'TColor, 'TDepth>) (filepath: string) =
- img.Save(filepath)
-
-
-let saveMat (mat: Matrix<'TDepth>) (filepath: string) =
- use img = new Image<Gray, 'TDeph>(mat.Size)
- mat.CopyTo(img)
- saveImg img filepath
-
-type Histogram = { data: int[]; total: int; sum: int; min: float32; max: float32 }
-
-let histogramImg (img: Image<Gray, float32>) (nbSamples: int) : Histogram =
- let imgData = img.Data
-
- let min, max =
- let min = ref [| 0.0 |]
- let minLocation = ref <| [| Point() |]
- let max = ref [| 0.0 |]
- let maxLocation = ref <| [| Point() |]
- img.MinMax(min, max, minLocation, maxLocation)
- float32 (!min).[0], float32 (!max).[0]
-
- let bin (x: float32) : int =
- let p = int ((x - min) / (max - min) * float32 nbSamples)
- if p >= nbSamples then nbSamples - 1 else p
-
- let data = Array.zeroCreate nbSamples
-
- for i in 0 .. img.Height - 1 do
- for j in 0 .. img.Width - 1 do
- let p = bin imgData.[i, j, 0]
- data.[p] <- data.[p] + 1
-
- { data = data; total = img.Height * img.Width; sum = Array.sum data; min = min; max = max }
-
-let histogramMat (mat: Matrix<float32>) (nbSamples: int) : Histogram =
- let matData = mat.Data
-
- let min, max =
- let min = ref 0.0
- let minLocation = ref <| Point()
- let max = ref 0.0
- let maxLocation = ref <| Point()
- mat.MinMax(min, max, minLocation, maxLocation)
- float32 !min, float32 !max
-
- let bin (x: float32) : int =
- let p = int ((x - min) / (max - min) * float32 nbSamples)
- if p >= nbSamples then nbSamples - 1 else p
-
- let data = Array.zeroCreate nbSamples
-
- for i in 0 .. mat.Height - 1 do
- for j in 0 .. mat.Width - 1 do
- let p = bin matData.[i, j]
- data.[p] <- data.[p] + 1
-
- { data = data; total = mat.Height * mat.Width; sum = Array.sum data; min = min; max = max }
-
-let histogram (values: float32 seq) (nbSamples: int) : Histogram =
- let mutable min = Single.MaxValue
- let mutable max = Single.MinValue
- let mutable n = 0
-
- for v in values do
- n <- n + 1
- if v < min then min <- v
- if v > max then max <- v
-
- let bin (x: float32) : int =
- let p = int ((x - min) / (max - min) * float32 nbSamples)
- if p >= nbSamples then nbSamples - 1 else p
-
- let data = Array.zeroCreate nbSamples
-
- for v in values do
- let p = bin v
- data.[p] <- data.[p] + 1
-
- { data = data; total = n; sum = Array.sum data; min = min; max = max }
-
-let otsu (hist: Histogram) : float32 * float32 * float32 =
- let mutable sumB = 0
- let mutable wB = 0
- let mutable maximum = 0.0
- let mutable level = 0
- let sum = hist.data |> Array.mapi (fun i v -> i * v) |> Array.sum |> float
-
- for i in 0 .. hist.data.Length - 1 do
- wB <- wB + hist.data.[i]
- if wB <> 0
- then
- let wF = hist.total - wB
- 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
- level <- i
- maximum <- between
-
- let mean1 =
- let mutable sum = 0
- let mutable nb = 0
- for i in 0 .. level - 1 do
- sum <- sum + i * hist.data.[i]
- nb <- nb + hist.data.[i]
- (sum + level * hist.data.[level] / 2) / (nb + hist.data.[level] / 2)
-
- let mean2 =
- let mutable sum = 0
- let mutable nb = 0
- for i in level + 1 .. hist.data.Length - 1 do
- sum <- sum + i * hist.data.[i]
- nb <- nb + hist.data.[i]
- (sum + level * hist.data.[level] / 2) / (nb + hist.data.[level] / 2)
-
- let toFloat l =
- float32 l / float32 hist.data.Length * (hist.max - hist.min) + hist.min
-
- toFloat level, toFloat mean1, toFloat mean2
-
-let suppressMConnections (img: Matrix<byte>) =
- let w = img.Width
- let h = img.Height
- for i in 1 .. h - 2 do
- for j in 1 .. 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
- img.[i, j] <- 0uy
- for i in 1 .. h - 2 do
- for j in 1 .. 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
- img.[i, j] <- 0uy
-
-let findEdges (img: Image<Gray, float32>) : Matrix<byte> * Image<Gray, float32> * Image<Gray, float32> =
- let w = img.Width
- let h = img.Height
-
- use sobelKernel =
- new ConvolutionKernelF(array2D [[ 1.0f; 0.0f; -1.0f ]
- [ 2.0f; 0.0f; -2.0f ]
- [ 1.0f; 0.0f; -1.0f ]], Point(1, 1))
-
- let xGradient = img.Convolution(sobelKernel)
- let yGradient = img.Convolution(sobelKernel.Transpose())
-
- let xGradientData = xGradient.Data
- let yGradientData = yGradient.Data
- for r in 0 .. h - 1 do
- xGradientData.[r, 0, 0] <- 0.f
- xGradientData.[r, w - 1, 0] <- 0.f
- yGradientData.[r, 0, 0] <- 0.f
- yGradientData.[r, w - 1, 0] <- 0.f
-
- for c in 0 .. w - 1 do
- xGradientData.[0, c, 0] <- 0.f
- xGradientData.[h - 1, c, 0] <- 0.f
- yGradientData.[0, c, 0] <- 0.f
- yGradientData.[h - 1, c, 0] <- 0.f
-
- use magnitudes = new Matrix<float32>(xGradient.Size)
- use angles = new Matrix<float32>(xGradient.Size)
- CvInvoke.CartToPolar(xGradient, yGradient, magnitudes, angles) // Compute the magnitudes (without angles).
-
- let thresholdHigh, thresholdLow =
- let sensibilityHigh = 0.1f
- let sensibilityLow = 0.0f
- use magnitudesByte = magnitudes.Convert<byte>()
- let threshold, _, _ = otsu (histogramMat magnitudes 300)
- threshold + (sensibilityHigh * threshold), threshold - (sensibilityLow * threshold)
-
- // Non-maximum suppression.
- use nms = new Matrix<byte>(xGradient.Size)
-
- let nmsData = nms.Data
- let anglesData = angles.Data
- let magnitudesData = magnitudes.Data
- let xGradientData = xGradient.Data
- let yGradientData = yGradient.Data
-
- let PI = float32 Math.PI
-
- for i in 0 .. h - 1 do
- nmsData.[i, 0] <- 0uy
- nmsData.[i, w - 1] <- 0uy
-
- for j in 0 .. w - 1 do
- nmsData.[0, j] <- 0uy
- nmsData.[h - 1, j] <- 0uy
-
- for i in 1 .. h - 2 do
- for j in 1 .. w - 2 do
- let vx = xGradientData.[i, j, 0]
- let vy = yGradientData.[i, j, 0]
- 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 m = magnitudesData.[i, j]
- 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 edges = new Matrix<byte>(xGradient.Size)
- let edgesData = edges.Data
-
- // Hysteresis thresholding.
- let toVisit = Stack<Point>()
- for i in 0 .. h - 1 do
- for j in 0 .. w - 1 do
- if nmsData.[i, j] = 1uy && magnitudesData.[i, j] >= thresholdHigh
- then
- nmsData.[i, j] <- 0uy
- toVisit.Push(Point(j, i))
- while toVisit.Count > 0 do
- let p = toVisit.Pop()
- edgesData.[p.Y, p.X] <- 1uy
- for i' in -1 .. 1 do
- for j' in -1 .. 1 do
- 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
- nmsData.[ni, nj] <- 0uy
- toVisit.Push(Point(nj, ni))
-
- edges, xGradient, yGradient
-
-let gaussianFilter (img : Image<'TColor, 'TDepth>) (standardDeviation : float) : Image<'TColor, 'TDepth> =
- let size = 2 * int (ceil (4.0 * standardDeviation)) + 1
- img.SmoothGaussian(size, size, standardDeviation, standardDeviation)
-
-type Points = HashSet<Point>
-
-let drawPoints (img: Image<Gray, 'TDepth>) (points: Points) (intensity: 'TDepth) =
- for p in points do
- img.Data.[p.Y, p.X, 0] <- intensity
-
-type ExtremumType =
- | Maxima = 1
- | Minima = 2
-
-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 result = List<List<Point>>()
-
- let flood (start: Point) : List<List<Point>> =
- let sameLevelToCheck = Stack<Point>()
- let betterLevelToCheck = Stack<Point>()
- betterLevelToCheck.Push(start)
-
- let result' = List<List<Point>>()
-
- while betterLevelToCheck.Count > 0 do
- let p = betterLevelToCheck.Pop()
- if not suppress.[p.Y, p.X]
- then
- suppress.[p.Y, p.X] <- true
- sameLevelToCheck.Push(p)
- let current = List<Point>()
-
- let mutable betterExists = false
-
- while sameLevelToCheck.Count > 0 do
- let p' = sameLevelToCheck.Pop()
- let currentLevel = imgData.[p'.Y, p'.X, 0]
- current.Add(p') |> ignore
- 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
- let level = imgData.[ni, nj, 0]
- let notSuppressed = not suppress.[ni, nj]
-
- 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
- betterExists <- true
- if notSuppressed
- then
- betterLevelToCheck.Push(Point(nj, ni))
-
- if not betterExists
- then
- result'.Add(current)
- result'
-
- for i in 0 .. h - 1 do
- for j in 0 .. w - 1 do
- let maxima = flood (Point(j, i))
- if maxima.Count > 0
- then
- result.AddRange(maxima)
-
- result.Select(fun l -> Points(l))
-
-let findMaxima (img: Image<Gray, 'TDepth>) : IEnumerable<Points> =
- findExtremum img ExtremumType.Maxima
-
-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 mutable highest = -1 // Value of the first elements of 'q'.
- let mutable lowest = size
-
- member this.NextMax () : byte * Point =
- if this.IsEmpty
- then
- invalidOp "Queue is empty"
- else
- let l = q.[highest]
- let next = l.First()
- l.Remove(next) |> ignore
- let value = byte highest
-
- if l.Count = 0
- then
- highest <- highest - 1
- while highest > lowest && q.[highest].Count = 0 do
- highest <- highest - 1
- if highest = lowest
- then
- highest <- -1
- lowest <- size
-
- value, next
-
- member this.NextMin () : byte * Point =
- if this.IsEmpty
- then
- invalidOp "Queue is empty"
- else
- let l = q.[lowest + 1]
- let next = l.First()
- l.Remove(next) |> ignore
- let value = byte (lowest + 1)
-
- if l.Count = 0
- then
- lowest <- lowest + 1
- while lowest < highest && q.[lowest + 1].Count = 0 do
- lowest <- lowest + 1
- if highest = lowest
- then
- highest <- -1
- lowest <- size
-
- value, next
-
- member this.Max =
- highest |> byte
-
- member this.Min =
- lowest + 1 |> byte
-
- member this.Add (value: byte) (p: Point) =
- let vi = int value
-
- if vi > highest
- then
- highest <- vi
- if vi <= lowest
- then
- lowest <- vi - 1
-
- q.[vi].Add(p) |> ignore
-
- 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
- highest <- highest - 1
- while highest > lowest && q.[highest].Count = 0 do
- highest <- highest - 1
- 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
- highest <- -1
- lowest <- size
-
- member this.IsEmpty =
- highest = -1
-
- member this.Clear () =
- while highest > lowest do
- q.[highest].Clear()
- highest <- highest - 1
- highest <- -1
- lowest <- size
-
-type private AreaState =
- | Removed = 1
- | Unprocessed = 2
- | Validated = 3
-
-type private AreaOperation =
- | Opening = 1
- | Closing = 2
-
-[<AllowNullLiteral>]
-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 w = img.Width
- let h = img.Height
- let imgData = img.Data
- let se = [| -1, 0; 0, -1; 1, 0; 0, 1 |]
-
- 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
- for m in areas do
- for e in m.Elements do
- pixels.[e.Y, e.X] <- m
-
- let queue = PriorityQueue()
-
- 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
- queue.Add (imgData.[ni, nj, 0]) p'
-
- // Reverse order is quicker.
- for i in areas.Count - 1 .. -1 .. 0 do
- let m = areas.[i]
- if m.Elements.Count <= area && m.State <> AreaState.Removed
- then
- queue.Clear()
- addEdgeToQueue m.Elements
-
- let mutable intensity = if op = AreaOperation.Opening then queue.Max else queue.Min
- let nextElements = Points()
-
- let mutable stop = false
- while not stop do
- 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
- 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
- m.Elements.UnionWith(nextElements)
- for e in nextElements do
- pixels.[e.Y, e.X] <- m
-
- if m.Elements.Count = area
- then
- m.State <- AreaState.Validated
- m.Intensity <- Some (intensity')
- stop <- true
- else
- intensity <- intensity'
- nextElements.Clear()
- nextElements.Add(p) |> ignore
-
- else
- match pixels.[p.Y, p.X] with
- | null -> ()
- | m' ->
- 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
- queue.Remove imgData.[e.Y, e.X, 0] e
- addEdgeToQueue m'.Elements
- m.Elements.UnionWith(m'.Elements)
- let intensityMax = if op = AreaOperation.Opening then queue.Max else queue.Min
- if intensityMax <> intensity
- then
- intensity <- intensityMax
- nextElements.Clear()
- merged <- true
-
- if not merged
- then
- m.State <- AreaState.Validated
- m.Intensity <- Some (intensity)
- stop <- true
-
- 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
- m.State <- AreaState.Validated
- m.Intensity <- Some (intensity)
- stop <- true
- 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
- 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
- match m.Intensity with
- | Some i ->
- for p in m.Elements do
- imgData.[p.Y, p.X, 0] <- i
- | _ -> ()
- ()
-
-let areaOpen (img: Image<Gray, byte>) (area: int) =
- areaOperation img area AreaOperation.Opening
-
-let areaClose (img: Image<Gray, byte>) (area: int) =
- areaOperation img area AreaOperation.Closing
-
-[<AllowNullLiteral>]
-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
-
-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 ownership: Island[,] = Array2D.create h w null
-
- // Initialize islands with their shore.
- let islands = List<Island>()
- let extremum = img |> if op = AreaOperation.Opening then findMaxima else findMinima
- for e in extremum do
- let island =
- let p = e.First()
- Island(comparer, Level = earth.[p.Y, p.X, 0], Surface = e.Count)
- islands.Add(island)
- let shorePoints = Points()
- for p in e do
- ownership.[p.Y, p.X] <- island
- for i, j in se do
- 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
- shorePoints.Add(neighbor) |> ignore
- island.Shore.Add earth.[ni, nj, 0] neighbor
-
- for area, obj in areas do
- for island in islands do
- let mutable stop = island.Shore.IsEmpty
-
- // 'true' if 'p' is owned or adjacent to 'island'.
- 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) ||
- (p.X > 0 && ownership.[p.Y, p.X - 1] = island) ||
- (p.X < w - 1 && ownership.[p.Y, p.X + 1] = 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
- island.Shore.RemoveNext ()
- else
- if not <| Object.ReferenceEquals(other, null)
- then // We touching another island.
- if island.Surface + other.Surface >= area
- then
- stop <- true
- else // We can merge 'other' into 'surface'.
- island.Surface <- island.Surface + other.Surface
- island.Level <- if comparer.Compare(island.Level, other.Level) > 0 then island.Level else other.Level
- for l, p in other.Shore do
- let mutable currentY = p.Y + 1
- while currentY < h && ownership.[currentY, p.X] = other do
- ownership.[currentY, p.X] <- island
- currentY <- currentY + 1
- island.Shore.Add l p
- other.Shore.Clear()
-
- 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
- island.Surface <- Int32.MaxValue
- stop <- true
- else
- let neighbor = Point(nj, ni)
- if not <| ownedOrAdjacent neighbor
- then
- island.Shore.Add earth.[ni, nj, 0] neighbor
- if not stop
- then
- ownership.[next.Y, next.X] <- island
- island.Level <- level
- island.Surface <- island.Surface + 1
-
- let mutable diff = 0.f
-
- for i in 0 .. h - 1 do
- for j in 0 .. w - 1 do
- match ownership.[i, j] with
- | null -> ()
- | island ->
- let l = island.Level
- diff <- diff + l - earth.[i, j, 0]
- earth.[i, j, 0] <- l
-
- match f with
- | Some f' -> f' obj diff
- | _ -> ()
- ()
-
-let areaOpenF (img: Image<Gray, float32>) (area: int) =
- areaOperationF img [ area, () ] None AreaOperation.Opening
-
-let areaCloseF (img: Image<Gray, float32>) (area: int) =
- areaOperationF img [ area, () ] None AreaOperation.Closing
-
-let areaOpenFWithFun (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: 'a -> float32 -> unit) =
- areaOperationF img areas (Some f) AreaOperation.Opening
-
-let areaCloseFWithFun (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: 'a -> float32 -> unit) =
- areaOperationF img areas (Some f) AreaOperation.Closing
-
-// A simpler algorithm than 'areaOpen' but slower.
-let areaOpen2 (img: Image<Gray, byte>) (area: int) =
- let w = img.Width
- let h = img.Height
- let imgData = img.Data
- let se = [| -1, 0; 0, -1; 1, 0; 0, 1 |]
-
- let histogram = Array.zeroCreate 256
- for i in 0 .. h - 1 do
- for j in 0 .. w - 1 do
- let v = imgData.[i, j, 0] |> int
- histogram.[v] <- histogram.[v] + 1
-
- let flooded : bool[,] = Array2D.zeroCreate h w
-
- let pointsChecked = HashSet<Point>()
- let pointsToCheck = Stack<Point>()
-
- for level in 255 .. -1 .. 0 do
- let mutable n = histogram.[level]
- if n > 0
- then
- for i in 0 .. h - 1 do
- for j in 0 .. w - 1 do
- if not flooded.[i, j] && imgData.[i, j, 0] = byte level
- then
- let mutable maxNeighborValue = 0uy
- pointsChecked.Clear()
- pointsToCheck.Clear()
- pointsToCheck.Push(Point(j, i))
-
- while pointsToCheck.Count > 0 do
- let next = pointsToCheck.Pop()
- pointsChecked.Add(next) |> ignore
- flooded.[next.Y, next.X] <- true
-
- 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
- let v = imgData.[p.Y, p.X, 0]
- if v = byte level
- then
- if not (pointsChecked.Contains(p))
- then
- pointsToCheck.Push(p)
- elif v > maxNeighborValue
- then
- maxNeighborValue <- v
-
- if int maxNeighborValue < level && pointsChecked.Count <= area
- then
- for p in pointsChecked do
- imgData.[p.Y, p.X, 0] <- maxNeighborValue
-
-// Zhang and Suen algorithm.
-// Modify 'mat' in place.
-let thin (mat: Matrix<byte>) =
- let w = mat.Width
- let h = mat.Height
- let mutable data1 = mat.Data
- let mutable data2 = Array2D.copy data1
-
- let mutable pixelChanged = true
- let mutable oddIteration = true
-
- while pixelChanged do
- pixelChanged <- false
- for i in 0..h-1 do
- for j in 0..w-1 do
- 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]
- let p5 = if i = h-1 || j = w-1 then 0uy else data1.[i+1, j+1]
- let p6 = if i = h-1 then 0uy else data1.[i+1, j]
- let p7 = if i = h-1 || j = 0 then 0uy else data1.[i+1, j-1]
- let p8 = if j = 0 then 0uy else data1.[i, j-1]
- let p9 = if i = 0 || j = 0 then 0uy else data1.[i-1, j-1]
-
- let sumNeighbors = p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9
- if sumNeighbors >= 2uy && sumNeighbors <= 6uy &&
- (if p2 = 0uy && p3 = 1uy then 1 else 0) +
- (if p3 = 0uy && p4 = 1uy then 1 else 0) +
- (if p4 = 0uy && p5 = 1uy then 1 else 0) +
- (if p5 = 0uy && p6 = 1uy then 1 else 0) +
- (if p6 = 0uy && p7 = 1uy then 1 else 0) +
- (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
- then
- data2.[i, j] <- 0uy
- pixelChanged <- true
- else
- data2.[i, j] <- 0uy
-
- oddIteration <- not oddIteration
- let tmp = data1
- data1 <- data2
- data2 <- tmp
-
-// Remove all 8-connected pixels with an area equal or greater than 'areaSize'.
-// Modify 'mat' in place.
-let removeArea (mat: Matrix<byte>) (areaSize: int) =
- let neighbors = [|
- (-1, 0) // p2
- (-1, 1) // p3
- ( 0, 1) // p4
- ( 1, 1) // p5
- ( 1, 0) // p6
- ( 1, -1) // p7
- ( 0, -1) // p8
- (-1, -1) |] // p9
-
- use mat' = new Matrix<byte>(mat.Size)
- let w = mat'.Width
- let h = mat'.Height
- mat.CopyTo(mat')
-
- let data = mat.Data
- let data' = mat'.Data
-
- for i in 0..h-1 do
- for j in 0..w-1 do
- if data'.[i, j] = 1uy
- then
- let neighborhood = List<Point>()
- let neighborsToCheck = Stack<Point>()
- neighborsToCheck.Push(Point(j, i))
- data'.[i, j] <- 0uy
-
- while neighborsToCheck.Count > 0 do
- let n = neighborsToCheck.Pop()
- neighborhood.Add(n)
- 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
- neighborsToCheck.Push(Point(pj, pi))
- data'.[pi, pj] <- 0uy
- 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>) : List<Point> =
- let w = img.Width
- let h = img.Height
-
- let pointChecked = Points()
- let pointToCheck = Stack<Point>(startPoints);
-
- let data = img.Data
-
- while pointToCheck.Count > 0 do
- let next = pointToCheck.Pop()
- pointChecked.Add(next) |> ignore
- for ny in -1 .. 1 do
- for nx in -1 .. 1 do
- 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
- pointToCheck.Push(p)
-
- List<Point>(pointChecked)
-
-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) =
- 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: Types.Ellipse) (color: 'TColor) (alpha: float) =
- if alpha >= 1.0
- then
- img.Draw(Ellipse(PointF(float32 e.Cx, float32 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 gapX = windowPosX - (float32 (int windowPosX))
-
- let windowPosY = e.Cy - e.A - 5.f
- let gapY = windowPosY - (float32 (int windowPosY))
-
- 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
- use i = new Image<'TColor, 'TDepth>(img.ROI.Size)
- i.Draw(Ellipse(PointF(float32 <| (e.A + 5.f + gapX) , float32 <| (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: Types.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: Types.Cell) =
- if drawCellContent
- then
- let colorB = rngCell.Next(20, 70)
- let colorG = rngCell.Next(20, 70)
- let colorR = rngCell.Next(20, 70)
-
- for y in 0 .. c.elements.Height - 1 do
- for x in 0 .. c.elements.Width - 1 do
- 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
- let r = img.Data.[y + dy, x + dx, 2] |> int
- img.Data.[y + dy, x + dx, 0] <- if b + colorB > 255 then 255uy else byte (b + colorB)
- img.Data.[y + dy, x + dx, 1] <- if g + colorG > 255 then 255uy else byte (g + colorG)
- img.Data.[y + dy, x + dx, 2] <- if r + colorR > 255 then 255uy else byte (r + colorR)
-
- let crossColor, crossColor2 =
- match c.cellClass with
- | Types.HealthyRBC -> Bgr(255., 0., 0.), Bgr(255., 255., 255.)
- | Types.InfectedRBC -> Bgr(0., 0., 255.), Bgr(120., 120., 255.)
- | Types.Peculiar -> Bgr(0., 0., 0.), Bgr(80., 80., 80.)
-
- drawLine img crossColor2 (c.center.X - 3) c.center.Y (c.center.X + 3) c.center.Y 2
- drawLine img crossColor2 c.center.X (c.center.Y - 3) c.center.X (c.center.Y + 3) 2
-
- 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: Types.Cell list) =
- List.iter (fun c -> drawCell img drawCellContent c) cells
\ No newline at end of file
+++ /dev/null
-module KMeans
-
-open System.Collections.Generic
-open System.Drawing
-
-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 =
- let nbIteration = 4
- let w = img.Width
- let h = img.Height
-
- 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 minf = float32 (!min).[0]
- let maxf = float32 (!max).[0]
-
- let mutable mean_bg = maxf - (maxf - minf) / 4.f
- let mutable mean_fg = minf + (maxf - minf) / 4.f
- use mutable d_bg : Image<Gray, float32> = null
- let mutable d_fg : Image<Gray, float32> = null
- let fg = new Image<Gray, byte>(img.Size)
-
- let imgData = img.Data
- let fgData = fg.Data
-
- for i in 1 .. nbIteration do
- match d_bg with
- | null -> ()
- | _ ->
- d_bg.Dispose()
- d_fg.Dispose()
-
- // EmGu doesn't import the in-place version of 'AbsDiff' so we have to create two images for each iteration.
- d_bg <- img.AbsDiff(Gray(float mean_bg))
- d_fg <- img.AbsDiff(Gray(float mean_fg))
-
- CvInvoke.Compare(d_fg, d_bg, fg, CvEnum.CmpType.LessThan)
-
- let mutable bg_total = 0.f
- let mutable bg_nb = 0
-
- let mutable fg_total = 0.f
- let mutable fg_nb = 0
-
- for i in 0 .. h - 1 do
- for j in 0 .. w - 1 do
- if fgData.[i, j, 0] > 0uy
- then
- fg_total <- fg_total + imgData.[i, j, 0]
- fg_nb <- fg_nb + 1
- else
- bg_total <- bg_total + imgData.[i, j, 0]
- bg_nb <- bg_nb + 1
-
- mean_bg <- bg_total / float32 bg_nb
- mean_fg <- fg_total / float32 fg_nb
-
- { fg = fg; mean_bg = mean_bg; mean_fg = mean_fg; d_fg = d_fg }
\ No newline at end of file
+++ /dev/null
-module KMedians
-
-open System.Collections.Generic
-open System.Drawing
-
-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 =
- let nbIteration = 4
- let w = img.Width
- let h = img.Height
-
- 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 mutable median_bg = (!max).[0] - ((!max).[0] - (!min).[0]) / 4.0
- let mutable median_fg = (!min).[0] + ((!max).[0] - (!min).[0]) / 4.0
- use mutable d_bg = new Image<Gray, float32>(img.Size)
- let mutable d_fg = new Image<Gray, float32>(img.Size)
- let mutable fg = new Image<Gray, byte>(img.Size)
-
- for i in 1 .. nbIteration do
- d_bg <- img.AbsDiff(Gray(median_bg))
- d_fg <- img.AbsDiff(Gray(median_fg))
-
- CvInvoke.Compare(d_fg, d_bg, fg, CvEnum.CmpType.LessThan)
-
- let bg_values = List<float>()
- let fg_values = List<float>()
-
- for i in 0 .. h - 1 do
- for j in 0 .. 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])
-
- median_bg <- MathNet.Numerics.Statistics.Statistics.Median(bg_values)
- median_fg <- MathNet.Numerics.Statistics.Statistics.Median(fg_values)
-
- { fg = fg; median_bg = median_bg; median_fg = median_fg; d_fg = d_fg }
-
-
-
-
+++ /dev/null
-module KdTree
-
-open System
-
-type I2DCoords =
- abstract X : float32
- abstract Y : float32
-
-// Compare 'e1' and 'e2' by X.
-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
- | v -> v
-
-// Compare 'e1' and 'e2' by Y.
-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
- member this.Contains px py : bool =
- px >= this.minX && px <= this.maxX &&
- py >= this.minY && py <= this.maxY
-
- member this.IsSub otherRegion : bool =
- this.minX >= otherRegion.minX && this.maxX <= otherRegion.maxX &&
- this.minY >= otherRegion.minY && this.maxY <= otherRegion.maxY
-
- member this.Intersects otherRegion : bool =
- this.minX < otherRegion.maxX && this.maxX >= otherRegion.minX &&
- this.minY < otherRegion.maxY && this.maxY >= otherRegion.minY
-
-type Tree<'a when 'a :> I2DCoords> =
- | Node of float32 * Tree<'a> * Tree<'a>
- | Leaf of '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
- Leaf pXSorted.[0]
- else
- if depth % 2 = 1 // 'depth' is odd -> vertical splitting else horizontal splitting.
- then
- 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.
- 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.
- 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>) : 'a list =
- match tree with
- | Leaf v -> [v]
- | Node (_, part1, part2) -> (valuesFrom part1) @ (valuesFrom part2)
-
- 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
- valuesFrom treeRegion
- elif region.Intersects searchRegion
- then
- searchWithRegion treeRegion region (depth + 1)
- else
- []
-
- if depth % 2 = 1 // Vertical splitting.
- then
- let leftRegion = { currentRegion with maxX = splitValue }
- let rightRegion = { currentRegion with minX = splitValue }
- (valuesInRegion leftRegion part1) @ (valuesInRegion rightRegion part2)
- else // Horizontal splitting.
- let downRegion = { currentRegion with maxY = splitValue }
- let upRegion = { currentRegion with minY = splitValue }
- (valuesInRegion downRegion part1) @ (valuesInRegion upRegion part2)
-
- searchWithRegion this { minX = Single.MinValue; maxX = Single.MaxValue; minY = Single.MinValue; maxY = Single.MaxValue } 1
-
-///// Tests. TODO: to put in a unit test.
-
-type Point (x: float32, y: float32) =
- interface I2DCoords with
- member this.X = x
- member this.Y = y
-
- override this.ToString () =
- sprintf "(%.1f, %.1f)" x 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 tree = Tree.BuildTree pts
- Utils.dprintfn "Tree: %A" tree
-
- let s1 = tree.Search { minX = 0.0f; maxX = 5.0f; minY = 0.0f; maxY = 5.0f } // All points.
- Utils.dprintfn "s1: %A" s1
-
- let s2 = tree.Search { minX = 2.8f; maxX = 4.5f; minY = 3.0f; maxY = 4.5f }
- Utils.dprintfn "s2: %A" s2
-
- let s3 = tree.Search { minX = 2.0f; maxX = 2.0f; minY = 2.0f; maxY = 2.0f }
- 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 tree = Tree.BuildTree pts
- Utils.dprintfn "Tree: %A" tree
-
- let s1 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 1.0f; maxY = 1.0f }
- Utils.dprintfn "s1: %A" s1
-
- let s2 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 2.0f; maxY = 2.0f }
- Utils.dprintfn "s2: %A" s2
-
- // This case result is wrong: FIXME
- let s3 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 3.0f; maxY = 3.0f }
- Utils.dprintfn "s3: %A" s3
-
- let s4 = tree.Search { minX = 0.0f; maxX = 2.0f; minY = 0.0f; maxY = 4.0f }
- Utils.dprintfn "s4: %A" s4
-
+++ /dev/null
-module ImageAnalysis
-
-open System
-open System.Linq
-open System.Drawing
-
-open FSharp.Collections.ParallelSeq
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Utils
-open ImgTools
-open Config
-open Types
-
-let doAnalysis (img: Image<Bgr, byte>) (name: string) (config: Config) (reportProgress: (int -> unit) option) : Cell list =
- // To report the progress of this function from 0 to 100.
- let inline report (percent: int) =
- match reportProgress with
- | Some f -> f percent
- | _ -> ()
-
- let inline buildLogWithName (text: string) = sprintf "(%s) %s" name text
- let logWithName = buildLogWithName >> log
- let inline logTimeWithName (text: string) (f: unit -> 'a) : 'a = logTime (buildLogWithName text) f
-
- logWithName "Starting analysis ..."
-
- use green = img.Item(1)
- let greenFloat = green.Convert<Gray, float32>()
- let filteredGreen = gaussianFilter greenFloat config.LPFStandardDeviation
-
- logWithName (sprintf "Nominal erytrocyte diameter: %A" config.RBCRadiusByResolution)
-
- let initialAreaOpening = int <| config.RBCRadiusByResolution.Area * config.Parameters.ratioAreaPaleCenter * 1.2f // We do an area opening a little larger to avoid to do a second one in the case the radius found is near the initial one.
- logTimeWithName "Area opening number one" (fun () -> ImgTools.areaOpenF filteredGreen initialAreaOpening)
-
- report 10
-
- let range =
- let delta = config.Parameters.granulometryRange * config.RBCRadiusByResolution.Pixel
- int <| config.RBCRadiusByResolution.Pixel - delta, int <| config.RBCRadiusByResolution.Pixel + delta
- //let r1 = log "Granulometry (morpho)" (fun() -> Granulometry.findRadiusByClosing (filteredGreen.Convert<Gray, byte>()) range 1.0 |> float32)
- config.SetRBCRadius <| logTimeWithName "Granulometry (area)" (fun() -> Granulometry.findRadiusByAreaClosing filteredGreen range |> float32)
-
- logWithName (sprintf "Found erytrocyte diameter: %A" config.RBCRadius)
-
- report 20
-
- let secondAreaOpening = int <| config.RBCRadius.Area * config.Parameters.ratioAreaPaleCenter
- if secondAreaOpening > initialAreaOpening
- then
- logTimeWithName "Area opening number two" (fun () -> ImgTools.areaOpenF filteredGreen secondAreaOpening)
-
- let parasites, filteredGreenWhitoutStain = ParasitesMarker.find filteredGreen config
- //let parasites, filteredGreenWhitoutInfection, filteredGreenWhitoutStain = ParasitesMarker.findMa greenFloat filteredGreenFloat config
-
- let edges, xGradient, yGradient = logTimeWithName "Finding edges" (fun () ->
- let edges, xGradient, yGradient = ImgTools.findEdges filteredGreenWhitoutStain
- removeArea edges (config.RBCRadius.Pixel ** 2.f / 50.f |> int)
- edges, xGradient, yGradient)
-
- let matchingEllipses = logTimeWithName "Finding ellipses" (fun () -> Ellipse.find edges xGradient yGradient config)
-
- report 60
-
- let prunedEllipses = logTimeWithName "Ellipses pruning" (fun () -> matchingEllipses.PrunedEllipses)
-
- report 80
-
- let cells = logTimeWithName "Classifier" (fun () -> Classifier.findCells prunedEllipses parasites filteredGreenWhitoutStain config)
-
- report 100
-
- logWithName "Analysis finished"
-
- // Output pictures if debug flag is set.
- match config.Debug with
- | DebugOn output ->
- let dirPath = System.IO.Path.Combine(output, name)
- System.IO.Directory.CreateDirectory dirPath |> ignore
-
- let buildFileName postfix = System.IO.Path.Combine(dirPath, name + postfix)
-
- saveMat (edges * 255.0) (buildFileName " - edges.png")
-
- saveImg parasites.darkStain (buildFileName " - parasites - dark stain.png")
- saveImg parasites.stain (buildFileName " - parasites - stain.png")
- saveImg parasites.infection (buildFileName " - parasites - infection.png")
-
- let imgAllEllipses = img.Copy()
- drawEllipses imgAllEllipses matchingEllipses.Ellipses (Bgr(255.0, 255.0, 255.0)) 0.04
- saveImg imgAllEllipses (buildFileName " - ellipses - all.png")
-
- let imgEllipses = filteredGreenWhitoutStain.Convert<Bgr, byte>()
- drawEllipses imgEllipses prunedEllipses (Bgr(0.0, 240.0, 240.0)) 1.0
- saveImg imgEllipses (buildFileName " - ellipses.png")
-
- let imgCells = img.Copy()
- drawCells imgCells false cells
- saveImg imgCells (buildFileName " - cells.png")
-
- let imgCells' = img.Copy()
- drawCells imgCells' true cells
- saveImg imgCells' (buildFileName " - cells - full.png")
-
- let filteredGreenMaxima = gaussianFilter greenFloat config.LPFStandardDeviation
- for m in ImgTools.findMaxima filteredGreenMaxima do
- ImgTools.drawPoints filteredGreenMaxima m 255.f
- saveImg filteredGreenMaxima (buildFileName " - filtered - maxima.png")
-
- saveImg filteredGreen (buildFileName " - filtered.png")
- saveImg filteredGreenWhitoutStain (buildFileName " - filtered closed stain.png")
- //saveImg filteredGreenWhitoutInfection (buildFileName " - filtered closed infection.png")
-
- saveImg green (buildFileName " - green.png")
-
- use blue = img.Item(0)
- saveImg blue (buildFileName " - blue.png")
-
- use red = img.Item(2)
- saveImg red (buildFileName " - red.png")
- | _ -> ()
-
- cells
-
-// ID * cell list.
-let doMultipleAnalysis (imgs: (string * Config * Image<Bgr, byte>) list) (reportProgress: (int -> unit) option) : (string * Cell list) list =
- let inline report (percent: int) =
- match reportProgress with
- | Some f -> f percent
- | _ -> ()
-
- let progressPerAnalysis = System.Collections.Concurrent.ConcurrentDictionary<string, int>()
- let nbImgs = List.length imgs
-
- let reportProgressImg (id: string) (progress: int) =
- progressPerAnalysis.AddOrUpdate(id, progress, (fun _ _ -> progress)) |> ignore
- report (progressPerAnalysis.Values.Sum() / nbImgs)
-
- let n = Environment.ProcessorCount
-
- imgs
- |> PSeq.map (fun (id, config, img) -> id, doAnalysis img id config (Some (fun p -> reportProgressImg id p)))
- |> PSeq.withDegreeOfParallelism n
- |> PSeq.toList
+++ /dev/null
-module MatchingEllipses
-
-open System
-open System.Linq
-open System.Collections
-open System.Collections.Generic
-
-open Types
-open Utils
-
-type private EllipseScoreFlaggedKd (matchingScore: float32, e: Ellipse) =
- let mutable matchingScore = matchingScore
-
- member this.Ellipse = e
-
- member this.MatchingScore = matchingScore
-
- member this.AddMatchingScore (score: float32) =
- matchingScore <- matchingScore + score
-
- member val Processed = false with get, set
- member val Removed = false with get, set
-
- interface KdTree.I2DCoords with
- member this.X = this.Ellipse.Cx
- member this.Y = this.Ellipse.Cy
-
-type MatchingEllipses (radius: float32) =
- let ellipses = List<EllipseScoreFlaggedKd>()
-
- // All ellipses with a score below this are removed.
- let matchingScoreThreshold = 1.f
-
- 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
- []
- else
- // 1) Create a kd-tree from the ellipses list.
- let tree = KdTree.Tree.BuildTree (List.ofSeq ellipses)
-
- // 2) Compute the matching score of each ellipses.
- let windowSize = radius / 2.f
- 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 }
- for other in tree.Search window do
- if not other.Processed
- then
- let areaOther = other.Ellipse.Area
- match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
- | Some (overlapArea, _, _) ->
- let matchingScore = (2.f * overlapArea / (areaE + areaOther)) ** 20.f
- if matchingScore <= 1.f // For approximation error.
- then
- other.AddMatchingScore(matchingScore)
- e.AddMatchingScore(matchingScore)
- | _ -> ()
-
- // 3) Remove ellipses whose center is near the center of another ellipse with a better score.
- for e in ellipses do
- 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 }
- for other in tree.Search window do
- if not other.Removed && e.MatchingScore > other.MatchingScore &&
- distanceTwoPoints (PointD(e.Ellipse.Cx, e.Ellipse.Cy)) (PointD(other.Ellipse.Cx, other.Ellipse.Cy)) < 0.3f * e.Ellipse.B
- then
- other.Removed <- true
-
- ellipses
- |> List.ofSeq
- |> List.filter (fun e -> not e.Removed)
- |> List.sortWith (fun e1 e2 -> e2.MatchingScore.CompareTo(e1.MatchingScore))
- |> List.map (fun e -> e.Ellipse)
-
+++ /dev/null
-<?xml version="1.0" encoding="utf-8"?>
-<Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
- <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
- <PropertyGroup>
- <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
- <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
- <SchemaVersion>2.0</SchemaVersion>
- <ProjectGuid>70838e65-f211-44fc-b28f-0ed1ca6e850f</ProjectGuid>
- <OutputType>WinExe</OutputType>
- <RootNamespace>Parasitemia</RootNamespace>
- <AssemblyName>Parasitemia</AssemblyName>
- <TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
- <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
- <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
- <Name>Parasitemia</Name>
- <NuGetPackageImportStamp>
- </NuGetPackageImportStamp>
- <TargetFrameworkProfile />
- <Win32Resource>resources.res</Win32Resource>
- </PropertyGroup>
- <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
- <DebugSymbols>true</DebugSymbols>
- <DebugType>full</DebugType>
- <Optimize>false</Optimize>
- <Tailcalls>false</Tailcalls>
- <OutputPath>bin\Debug\</OutputPath>
- <DefineConstants>DEBUG;TRACE</DefineConstants>
- <WarningLevel>3</WarningLevel>
- <PlatformTarget>x64</PlatformTarget>
- <DocumentationFile>bin\Debug\Parasitemia.XML</DocumentationFile>
- <Prefer32Bit>false</Prefer32Bit>
- <StartArguments>--folder "../../../Images/debug" --output "../../../Images/output" --debug</StartArguments>
- </PropertyGroup>
- <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'DebugGUI|AnyCPU' ">
- <DebugSymbols>true</DebugSymbols>
- <DebugType>full</DebugType>
- <Optimize>false</Optimize>
- <Tailcalls>false</Tailcalls>
- <DefineConstants>DEBUG;TRACE</DefineConstants>
- <WarningLevel>3</WarningLevel>
- <PlatformTarget>x64</PlatformTarget>
- <DocumentationFile>bin\Debug\Parasitemia.XML</DocumentationFile>
- <Prefer32Bit>false</Prefer32Bit>
- <StartArguments>--output "../../../Images/output" --debug</StartArguments>
- <OutputPath>bin\DebugGUI\</OutputPath>
- </PropertyGroup>
- <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
- <DebugType>pdbonly</DebugType>
- <Optimize>true</Optimize>
- <Tailcalls>true</Tailcalls>
- <OutputPath>bin\Release\</OutputPath>
- <DefineConstants>TRACE</DefineConstants>
- <WarningLevel>3</WarningLevel>
- <PlatformTarget>AnyCPU</PlatformTarget>
- <DocumentationFile>bin\Release\Parasitemia.XML</DocumentationFile>
- <Prefer32Bit>false</Prefer32Bit>
- <StartArguments>--folder "../../../Images/release" --output "../../../Images/output" --debug</StartArguments>
- </PropertyGroup>
- <PropertyGroup>
- <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
- </PropertyGroup>
- <Choose>
- <When Condition="'$(VisualStudioVersion)' == '11.0'">
- <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
- <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
- </PropertyGroup>
- </When>
- <Otherwise>
- <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
- <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
- </PropertyGroup>
- </Otherwise>
- </Choose>
- <Import Project="$(FSharpTargetsPath)" />
- <ItemGroup>
- <Compile Include="AssemblyInfo.fs" />
- <Compile Include="Heap.fs" />
- <Compile Include="UnitsOfMeasure.fs" />
- <Compile Include="Const.fs" />
- <Compile Include="Types.fs" />
- <Compile Include="EEOver.fs" />
- <Compile Include="Utils.fs" />
- <Compile Include="ImgTools.fs" />
- <Compile Include="Granulometry.fs" />
- <Compile Include="Config.fs" />
- <Compile Include="KMedians.fs" />
- <Compile Include="KMeans.fs" />
- <Compile Include="ParasitesMarker.fs" />
- <Compile Include="KdTree.fs" />
- <Compile Include="MatchingEllipses.fs" />
- <Compile Include="Ellipse.fs" />
- <Compile Include="Classifier.fs" />
- <Compile Include="MainAnalysis.fs" />
- <Resource Include="GUI\NumericUpDown.xaml" />
- <Compile Include="GUI\NumericUpDown.xaml.fs" />
- <Resource Include="GUI\ImageSourcePreview.xaml" />
- <Compile Include="GUI\ImageSourcePreview.xaml.fs" />
- <Resource Include="GUI\ImageSourceSelection.xaml" />
- <Compile Include="GUI\ImageSourceSelection.xaml.fs" />
- <Resource Include="GUI\RBCFrame.xaml" />
- <Compile Include="GUI\RBCFrame.xaml.fs" />
- <Resource Include="GUI\AnalysisWindow.xaml" />
- <Compile Include="GUI\AnalysisWindow.xaml.fs" />
- <Resource Include="GUI\AboutWindow.xaml" />
- <Compile Include="GUI\AboutWindow.xaml.fs" />
- <Resource Include="GUI\MainWindow.xaml" />
- <Compile Include="GUI\MainWindow.xaml.fs" />
- <Compile Include="GUI\Types.fs" />
- <Compile Include="GUI\PiaZ.fs" />
- <Compile Include="GUI\State.fs" />
- <Compile Include="GUI\About.fs" />
- <Compile Include="GUI\Analysis.fs" />
- <Compile Include="GUI\GUI.fs" />
- <Compile Include="Program.fs" />
- <None Include="App.config" />
- <Content Include="packages.config" />
- <Resource Include="Resources\icon.ico" />
- <None Include="Scripts\load-references-debug.fsx" />
- <None Include="Scripts\load-project-debug.fsx" />
- <None Include="Scripts\load-references-release.fsx" />
- <None Include="Scripts\load-project-release.fsx" />
- <None Include="Scripts\load-references-debuggui.fsx" />
- <None Include="Scripts\load-project-debuggui.fsx" />
- </ItemGroup>
- <ItemGroup>
- <Reference Include="Castle.Core">
- <HintPath>..\packages\Castle.Core.3.3.3\lib\net45\Castle.Core.dll</HintPath>
- <Private>True</Private>
- </Reference>
- <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>
- <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), 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>
- </Reference>
- <Reference Include="FsXaml.Wpf">
- <HintPath>..\packages\FsXaml.Wpf.0.9.9\lib\net45\FsXaml.Wpf.dll</HintPath>
- <Private>True</Private>
- </Reference>
- <Reference Include="FsXaml.Wpf.TypeProvider">
- <HintPath>..\packages\FsXaml.Wpf.0.9.9\lib\net45\FsXaml.Wpf.TypeProvider.dll</HintPath>
- <Private>True</Private>
- </Reference>
- <Reference Include="log4net">
- <HintPath>..\packages\log4net.2.0.5\lib\net45-full\log4net.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>
- </Reference>
- <Reference Include="MathNet.Numerics.FSharp">
- <HintPath>..\packages\MathNet.Numerics.FSharp.3.10.0\lib\net40\MathNet.Numerics.FSharp.dll</HintPath>
- <Private>True</Private>
- </Reference>
- <Reference Include="mscorlib" />
- <Reference Include="Newtonsoft.Json">
- <HintPath>..\packages\Newtonsoft.Json.8.0.2\lib\net45\Newtonsoft.Json.dll</HintPath>
- <Private>True</Private>
- </Reference>
- <Reference Include="PresentationCore" />
- <Reference Include="PresentationFramework" />
- <Reference Include="System" />
- <Reference Include="System.Core" />
- <Reference Include="System.Data" />
- <Reference Include="System.Data.DataSetExtensions" />
- <Reference Include="System.Data.Linq" />
- <Reference Include="System.Drawing" />
- <Reference Include="System.IO.Compression" />
- <Reference Include="System.IO.Compression.FileSystem" />
- <Reference Include="System.Numerics" />
- <Reference Include="System.Windows.Interactivity">
- <HintPath>..\packages\Expression.Blend.Sdk.1.0.2\lib\net45\System.Windows.Interactivity.dll</HintPath>
- <Private>True</Private>
- </Reference>
- <Reference Include="System.Xaml" />
- <Reference Include="System.Xml" />
- <Reference Include="System.Xml.Linq" />
- <Reference Include="WindowsBase" />
- </ItemGroup>
- <ItemGroup>
- <ProjectReference Include="..\WPF\WPF.csproj">
- <Name>WPF</Name>
- <Project>{314fd78e-870e-4794-bb16-ea4586f2abdb}</Project>
- <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>
- </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.
- <Target Name="BeforeBuild">
- </Target>
- <Target Name="AfterBuild">
- </Target>
- -->
-</Project>
\ No newline at end of file
+++ /dev/null
-module ParasitesMarker
-
-open System.Drawing
-open System.Linq
-
-open Emgu.CV
-open Emgu.CV.Structure
-open Utils
-
-type Result = {
- darkStain: Image<Gray, byte>
- infection: Image<Gray, byte>
- stain: Image<Gray, byte> }
-
-// Create three binary markers :
-// * 'Dark stain' corresponds to the colored pixel, it's independent of the size of the areas.
-// * 'Stain' corresponds to the stain around the parasites.
-// * 'Infection' corresponds to the parasite. It shouldn't contain thrombocytes.
-let findMa (green: Image<Gray, float32>) (filteredGreen: Image<Gray, float32>) (config: Config.Config) : Result * Image<Gray, byte> * Image<Gray, byte> =
- // We use the filtered image to find the dark stain.
- let kmediansResults = logTime "Finding fg/bg (k-medians)" (fun () -> KMedians.kmedians filteredGreen)
- let { KMedians.fg = fg; KMedians.median_bg = median_bg; KMedians.median_fg = median_fg; KMedians.d_fg = d_fg } = kmediansResults
- let darkStain = d_fg.Cmp(median_bg * float config.Parameters.darkStainLevel, CvEnum.CmpType.GreaterThan)
- darkStain._And(filteredGreen.Cmp(median_fg, CvEnum.CmpType.LessThan))
- darkStain._And(fg)
-
- let fgFloat = (fg / 255.0).Convert<Gray, float32>()
- use greenWithoutBg = ImgTools.gaussianFilter green 1.0
- greenWithoutBg.SetValue(Gray(0.0), fg.Not())
-
- let findSmears (sigma: float) (level: float) : Image<Gray, byte> =
- use greenWithoutBgSmoothed = ImgTools.gaussianFilter greenWithoutBg sigma
- use fgSmoothed = ImgTools.gaussianFilter fgFloat sigma
- let smears = (greenWithoutBg.Mul(fgSmoothed)).Cmp(greenWithoutBgSmoothed.Mul(level), CvEnum.CmpType.LessThan)
- smears._And(fg)
- smears
-
- let tmp = filteredGreen.Convert<Gray, byte>()
-
- { darkStain = darkStain;
- stain = findSmears 10. 0.9
- infection = findSmears 2.2 0.87 },
- tmp,
- tmp
-
-// Create three binary markers :
-// * 'Dark stain' corresponds to the colored pixel, it's independent of the size of the areas.
-// * 'Stain' corresponds to the stain around the parasites.
-// * 'Infection' corresponds to the parasite. It shouldn't contain thrombocytes.
-let find (filteredGreen: Image<Gray, float32>) (config: Config.Config) : Result * Image<Gray, float32> =
- use filteredGreenWithoutInfection = filteredGreen.Copy()
- ImgTools.areaCloseF filteredGreenWithoutInfection (int config.RBCRadius.InfectionArea)
-
- let filteredGreenWithoutStain = filteredGreenWithoutInfection.Copy()
- ImgTools.areaCloseF filteredGreenWithoutStain (int config.RBCRadius.StainArea)
-
- let darkStain =
- // We use the filtered image to find the dark stain.
- let _, mean_fg, mean_bg =
- let hist = ImgTools.histogramImg filteredGreenWithoutInfection 300
- ImgTools.otsu hist
- filteredGreenWithoutInfection.Cmp(-(float mean_bg) * config.Parameters.darkStainLevel + (float mean_fg), CvEnum.CmpType.LessThan)
-
- 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)
- diff._ThresholdBinary(Gray(0.0), Gray(255.))
- diff.Convert<Gray, byte>()
-
- let infectionMarker = marker filteredGreen filteredGreenWithoutInfection (1. / config.Parameters.infectionSensitivity)
- let stainMarker = marker filteredGreenWithoutInfection filteredGreenWithoutStain (1. / config.Parameters.stainSensitivity)
-
- // TODO: comprendre pourquoi des valeurs sont negatives!?!?
- (*
- let blackTopHat = filteredGreen.CopyBlank()
- CvInvoke.Subtract(filteredGreenWithoutInfection, filteredGreen, blackTopHat)
- ImgTools.saveImg (ImgTools.normalizeAndConvert blackTopHat) "BottomHat.png"
- *)
-
- { darkStain = darkStain
- infection = infectionMarker
- stain = stainMarker },
- filteredGreenWithoutStain
-
-
+++ /dev/null
-module Parasitemia.Main
-
-open System
-open System.IO
-open System.Threading
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Config
-
-type Input =
- | File of string
- | Dir of string
-
-type RunningMode =
- | CmdLine of Input * string // A file or a directory to process and the output directory.
- | Window of string option // An optional path to a file to open can be given in window mode.
-
-type Arguments = RunningMode * bool
-
-let parseArgs (args: string[]) : Arguments =
-
- let output = Array.tryFindIndex ((=) "--output") args
-
- let runningMode =
- match Array.tryFindIndex ((=) "--folder") args, output with
- | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
- CmdLine ((Dir args.[i+1]), args.[i_output + 1])
- | _ ->
- match Array.tryFindIndex ((=) "--file") args, output with
- | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
- CmdLine ((File args.[i+1]), args.[i_output + 1])
- |_ ->
- Window (if args.Length > 0 && not (args.[0].StartsWith("--")) then Some args.[0] else None)
-
- runningMode, Array.exists ((=) "--debug") args
-
-[<EntryPoint>]
-[<STAThread()>]
-let main args =
-
- let e = Ellipse.ellipse2 -11.4 -7.8 -0.169811 -23.75 0.8 -3.885714 -19. 1.5
-
- match parseArgs args with
- | mode, debug ->
- let config = Config(defaultParameters)
-
- match mode with
- | CmdLine (input, output) ->
- if debug
- then
- config.Debug <- DebugOn output
-
- Directory.CreateDirectory output |> ignore
-
- use logFile = new StreamWriter(new FileStream(Path.Combine(output, "log.txt"), FileMode.Append, FileAccess.Write))
- Utils.log <- (fun m -> logFile.WriteLine(m))
- Utils.log (sprintf "=== New run : %A %A ===" DateTime.Now (if debug then "[DEBUG]" else "[RELEASE]"))
-
- let files = match input with
- | File file -> [ file ]
- | Dir dir -> Directory.EnumerateFiles dir |> List.ofSeq
-
- use resultFile = new StreamWriter(new FileStream(Path.Combine(output, "results.txt"), FileMode.Append, FileAccess.Write))
-
- //try
- let images = [ for file in files -> Path.GetFileNameWithoutExtension(FileInfo(file).Name), config.Copy(), new Image<Bgr, byte>(file) ]
-
-
- Utils.logTime "Whole analyze" (fun () ->
- let results = ImageAnalysis.doMultipleAnalysis images None
-
- for id, cells in results do
- let config = images |> List.pick (fun (id', config', _) -> if id' = id then Some config' else None)
- let total, infected = Utils.countCells cells
- fprintf resultFile "File: %s %d %d %.2f (diameter: %A)\n" id total infected (100. * (float infected) / (float total)) config.RBCRadius)
-
- //Utils.log (sprintf "== File: %A" file)
- //with
- //| :? IOException as ex -> Utils.log (sprintf "Unable to open the image '%A': %A" file ex)
- 0
-
- | Window fileToOpen ->
- (*let display (window : Views.MainWindow) (img : IImage) =
- let imgControl = window.Root.FindName("img") :?> Controls.Image
- imgControl.Source <- BitmapSourceConvert.ToBitmapSource(img)
-
- let log (window : Views.MainWindow) (mess : string) =
- let txtLog = window.Root.FindName("txtLog") :?> Controls.TextBlock
- txtLog.Text <- txtLog.Text + mess + "\n"*)
-
- if debug then config.Debug <- DebugOn "."
- GUI.Main.run config fileToOpen
+++ /dev/null
-module Types
-
-open System
-open System.Drawing
-
-open Emgu.CV
-open Emgu.CV.Structure
-
-open Const
-
-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.B = b
- member this.Alpha = alpha
- member this.Area = a * b * PI
-
- // Does the ellipse contain the point (x, y)?.
- 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 =
- 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 =
- 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) =
- 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(this.Cx, this.Cy, this.A * factor, this.B * factor, alpha)
-
- // Approximation of Ramanujan.
- member this.Perimeter =
- 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
-
-type CellClass = HealthyRBC | InfectedRBC | Peculiar
-
-type Cell = {
- cellClass: CellClass
- center: Point
- infectedArea: int
- stainArea: int
- elements: Matrix<byte> }
-
-[<Struct>]
-type Line (a: float32, b: float32) =
- member this.A = a
- member this.B = b
- member this.Valid = not (Single.IsInfinity this.A)
-
-[<Struct>]
-type PointD (x: float32, y: float32) =
- member this.X = x
- member this.Y = y
-
+++ /dev/null
-module UnitsOfMeasure
-
-[<Measure>] type px
-[<Measure>] type μm
-[<Measure>] type inch
-[<Measure>] type ppi = px / inch
-
-let μmInchRatio = 25.4e3<μm/inch>
-
-let μmToInch(x: float<μm>) : float<inch> = x / μmInchRatio
-let inchToμm(x: float<inch>) : float<μm> = x * μmInchRatio
-
-
-
-
-
+++ /dev/null
-module Utils
-
-open System.Diagnostics
-
-open Types
-
-let inline roundInt v = v |> round |> int
-
-let inline dprintfn fmt =
- Printf.ksprintf System.Diagnostics.Debug.WriteLine fmt
-
-let mutable log : (string -> unit) =
- fun m -> ()
-
-let logTime (m: string) (f: unit -> 'a) : 'a =
- let sw = Stopwatch()
- sw.Start()
- let res = f ()
- sw.Stop()
- log <| sprintf "%s (time: %d ms)" m sw.ElapsedMilliseconds
- res
-
-let inline lineFromTwoPoints (p1: PointD) (p2: PointD) : Line =
- let a = (p1.Y - p2.Y) / (p1.X - p2.X)
- let b = -(p2.X * p1.Y - p1.X * p2.Y) / (p1.X - p2.X)
- Line(a, b)
-
-let inline pointFromTwoLines (l1: Line) (l2: Line) : PointD =
- let x = -(l1.B - l2.B) / (l1.A - l2.A)
- let y = -(l2.A * l1.B - l1.A * l2.B) / (l1.A - l2.A)
- PointD(x, y)
-
-let inline linePassThroughSegment (l: Line) (p1: PointD) (p2: PointD) : bool =
- let p = pointFromTwoLines l (lineFromTwoPoints p1 p2)
- sign (p.X - p1.X) <> sign (p.X - p2.X)
-
-let inline squaredDistanceTwoPoints (p1: PointD) (p2: PointD) =
- (p1.X - p2.X) ** 2.f + (p1.Y - p2.Y) ** 2.f
-
-let inline distanceTwoPoints (p1: PointD) (p2: PointD) =
- 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
+++ /dev/null
-<?xml version="1.0" encoding="utf-8"?>
-<packages>
- <package id="Castle.Core" version="3.3.3" targetFramework="net461" />
- <package id="Expression.Blend.Sdk" version="1.0.2" targetFramework="net46" />
- <package id="FSharp.Collections.ParallelSeq" version="1.0.2" targetFramework="net461" />
- <package id="FSharp.Core" version="4.0.0.1" targetFramework="net461" />
- <package id="FSharp.Data" version="2.2.5" 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="log4net" version="2.0.5" targetFramework="net461" />
- <package id="MathNet.Numerics" version="3.10.0" targetFramework="net461" />
- <package id="MathNet.Numerics.FSharp" version="3.10.0" targetFramework="net461" />
- <package id="Newtonsoft.Json" version="8.0.2" targetFramework="net452" />
-</packages>
\ No newline at end of file
+++ /dev/null
-1 ICON "resources\icon.ico"
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaCore.AssemblyInfo
+
+open System.Reflection
+open System.Runtime.CompilerServices
+open System.Runtime.InteropServices
+
+// General Information about an assembly is controlled through the following
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+[<assembly: AssemblyTitle("ParasitemiaCore")>]
+[<assembly: AssemblyDescription("")>]
+[<assembly: AssemblyConfiguration("")>]
+[<assembly: AssemblyCompany("")>]
+[<assembly: AssemblyProduct("ParasitemiaCore")>]
+[<assembly: AssemblyCopyright("Copyright © 2016")>]
+[<assembly: AssemblyTrademark("")>]
+[<assembly: AssemblyCulture("")>]
+
+// Setting ComVisible to false makes the types in this assembly not visible
+// to COM components. If you need to access a type in this assembly from
+// COM, set the ComVisible attribute to true on that type.
+[<assembly: ComVisible(false)>]
+
+// The following GUID is for the ID of the typelib if this project is exposed to COM
+[<assembly: Guid("0f8a85f4-9328-40c3-b8ff-44fb39ceb01f")>]
+
+// Version information for an assembly consists of the following four values:
+//
+// Major Version
+// Minor Version
+// Build Number
+// Revision
+//
+// 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.0")>]
+[<assembly: AssemblyFileVersion("1.0.0.0")>]
+
+do
+ ()
\ No newline at end of file
--- /dev/null
+module ParasitemiaCore.Classifier
+
+open System
+open System.Collections.Generic
+open System.Drawing
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Types
+open Utils
+
+
+type private EllipseFlaggedKd (e: Ellipse) =
+ inherit Ellipse (e.Cx, e.Cy, e.A, e.B, e.Alpha)
+
+ member val Removed = false with get, set
+
+ interface KdTree.I2DCoords with
+ member this.X = this.Cx
+ member this.Y = this.Cy
+
+
+let findCells (ellipses: Ellipse list) (parasites: ParasitesMarker.Result) (img: Image<Gray, float32>) (config: Config.Config) : Cell list =
+ if ellipses.IsEmpty
+ then
+ []
+ else
+ let infection = parasites.infection.Copy() // To avoid to modify the parameter.
+
+ // 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) }
+
+ // The minimum window to contain a given 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
+
+ let w = img.Width
+ let w_f = float32 w
+ let h = img.Height
+ let h_f = float32 h
+
+ // Return 'true' if the point 'p' is owned by e.
+ // The lines represents all intersections with other ellipses.
+ let pixelOwnedByE (p: PointD) (e: Ellipse) (others: (Ellipse * Line) list) =
+ e.Contains p.X p.Y &&
+ seq {
+ let c = PointD(e.Cx, e.Cy)
+ for e', d1 in others do
+ let d2 = Utils.lineFromTwoPoints c p
+ let c' = PointD(e'.Cx, e'.Cy)
+ let v = pointFromTwoLines d1 (lineFromTwoPoints c c')
+ let case1 = sign (v.X - c.X) <> sign (v.X - c'.X) || Utils.squaredDistanceTwoPoints v c > Utils.squaredDistanceTwoPoints v c'
+ if d2.Valid
+ then
+ let p' = Utils.pointFromTwoLines d1 d2
+ // Yield 'false' when the point is owned by another ellipse.
+ if case1
+ then
+ yield sign (c.X - p.X) <> sign (c.X - p'.X) || Utils.squaredDistanceTwoPoints c p' > Utils.squaredDistanceTwoPoints c p
+ else
+ yield sign (c.X - p.X) = sign (c.X - p'.X) && Utils.squaredDistanceTwoPoints c p' < Utils.squaredDistanceTwoPoints c p
+ else
+ yield case1
+ } |> Seq.forall id
+
+ let ellipses = ellipses |> List.map EllipseFlaggedKd
+
+ // 1) Associate touching ellipses with each ellipses and remove ellipse with more than two intersections.
+ let tree = KdTree.Tree.BuildTree ellipses
+ let neighbors (e: EllipseFlaggedKd) : (EllipseFlaggedKd * PointD * PointD) list =
+ if not e.Removed
+ then
+ tree.Search (searchRegion e)
+ // We only keep the ellipses touching 'e'.
+ |> List.choose (fun otherE ->
+ if e <> otherE
+ then
+ match EEOver.EEOverlapArea e otherE with
+ | Some (_, px, _) when px.Length > 2 ->
+ otherE.Removed <- true
+ None
+ | Some (area, px, py) when area > 0.f && px.Length = 2 ->
+ Some (otherE, PointD(px.[0], py.[0]), PointD(px.[1], py.[1]))
+ | _ ->
+ None
+ else
+ None )
+ else
+ []
+
+ // We reverse the list to get the lower score ellipses first.
+ let ellipsesWithNeigbors = ellipses |> List.map (fun e -> e, neighbors e) |> List.rev
+
+ // 2) Remove ellipses touching the edges.
+ for e in ellipses do
+ if e.isOutside w_f h_f then e.Removed <- true
+
+ // 3) Remove ellipses with a high standard deviation (high contrast).
+ let imgData = img.Data
+ let globalStdDeviation = MathNet.Numerics.Statistics.Statistics.PopulationStandardDeviation(seq {
+ for y in 0 .. h - 1 do
+ for x in 0 .. w - 1 do
+ yield float imgData.[y, x, 0] })
+
+ for e in ellipses do
+ 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
+ yield float imgData.[y, x, 0] })
+
+ if stdDeviation > globalStdDeviation * config.Parameters.standardDeviationMaxRatio then
+ e.Removed <- true
+
+
+ // 4) Remove ellipses with little area.
+ let minArea = config.RBCRadius.MinArea
+ for e, neighbors in ellipsesWithNeigbors do
+ if not e.Removed
+ then
+ let minX, minY, maxX, maxY = ellipseWindow e
+
+ let mutable area = 0
+ for y in (if minY < 0 then 0 else minY) .. (if maxY >= h then h - 1 else maxY) do
+ for x in (if minX < 0 then 0 else minX) .. (if maxX >= w then w - 1 else maxX) do
+ let p = PointD(float32 x, float32 y)
+ if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
+ then
+ area <- area + 1
+
+ if area < int minArea
+ then
+ e.Removed <- true
+
+ // 5) Define pixels associated to each ellipse and create the cells.
+ ellipsesWithNeigbors
+ |> List.choose (fun (e, neighbors) ->
+ if e.Removed
+ then
+ None
+ else
+ let minX, minY, maxX, maxY = ellipseWindow e
+
+ let infectedPixels = List<Point>()
+ let mutable stainPixels = 0
+ let mutable darkStainPixels = 0
+ let mutable nbElement = 0
+
+ let elements = new Matrix<byte>(maxY - minY + 1, maxX - minX + 1)
+ for y in minY .. maxY do
+ for x in minX .. maxX do
+ let p = PointD(float32 x, float32 y)
+ if pixelOwnedByE p e (neighbors |> List.choose (fun (otherE, p1, p2) -> if otherE.Removed then None else Some (otherE :> Ellipse, Utils.lineFromTwoPoints p1 p2)))
+ then
+ elements.[y-minY, x-minX] <- 1uy
+ nbElement <- nbElement + 1
+
+ if infection.Data.[y, x, 0] > 0uy
+ then
+ infectedPixels.Add(Point(x, y))
+
+ if parasites.stain.Data.[y, x, 0] > 0uy
+ then
+ stainPixels <- stainPixels + 1
+
+ if parasites.darkStain.Data.[y, x, 0] > 0uy
+ then
+ darkStainPixels <- darkStainPixels + 1
+
+ let cellClass =
+ if float darkStainPixels > config.Parameters.maxDarkStainRatio * (float nbElement) ||
+ float stainPixels > config.Parameters.maxStainRatio * (float nbElement)
+ then
+ Peculiar
+ elif infectedPixels.Count >= 1
+ then
+ let infectionToRemove = ImgTools.connectedComponents parasites.stain infectedPixels
+ for p in infectionToRemove do
+ infection.Data.[p.Y, p.X, 0] <- 0uy
+ InfectedRBC
+ else
+ HealthyRBC
+
+ Some { cellClass = cellClass
+ center = Point(roundInt e.Cx, roundInt e.Cy)
+ infectedArea = infectedPixels.Count
+ stainArea = stainPixels
+ elements = elements })
--- /dev/null
+module ParasitemiaCore.Config
+
+open System
+
+open Const
+open UnitsOfMeasure
+
+type Debug =
+ | DebugOff
+ | DebugOn of string // Output directory.
+
+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'.
+
+ 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.
+
+ LPFStandardDeviation: float<μm> // Sigma parameter of the gaussian to remove the high frequency noise.
+
+ // Ellipse.
+ factorNbPick: float // The number of computed ellipse per edge pixel.
+
+ // 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.
+
+ stainArea: float32 // Factor of a RBC area. 0.5 means the half of RBC area.
+ stainSensitivity: float // between 0 (the least sensitive) and 1 (the most sensitive).
+ maxStainRatio: float // A cell must own less than this ratio to be a RBC.
+
+ infectionArea: 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).
+
+ 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 = 8.<μm>
+ resolution = 220.e3<ppi> // Correspond to 50X.
+
+ ratioAreaPaleCenter = 1.f / 3.f // The ratio between an RBC area and the area of the its pale center.
+
+ granulometryRange = 0.5f
+
+ minRbcRadius = -0.3f
+ maxRbcRadius = 0.3f
+
+ LPFStandardDeviation = 0.2<μm> // 8.5e-6<inch>.
+
+ factorNbPick = 1.0
+
+ darkStainLevel = 0.25 // 0.3
+ maxDarkStainRatio = 0.1 // 10 %
+
+ infectionArea = 0.012f // 1.2 %
+ infectionSensitivity = 0.9
+
+ stainArea = 0.08f // 8 %
+ stainSensitivity = 0.9
+ maxStainRatio = 0.12 // 12 %
+
+ standardDeviationMaxRatio = 0.5 // 0.5
+ minimumCellAreaFactor = 0.4f }
+
+type RBCRadius (radius: float32, parameters: Parameters) =
+ member this.Pixel = radius
+ member this.μm : float<μm> =
+ 1.<px> * (float radius) / parameters.resolution |> inchToμm
+
+ member this.Min = radius + parameters.minRbcRadius * radius
+ member this.Max = radius + parameters.maxRbcRadius * radius
+
+ member this.Area = PI * radius ** 2.f
+ member this.MinArea = parameters.minimumCellAreaFactor * radius
+
+ member this.InfectionArea = parameters.infectionArea * this.Area
+ member this.StainArea = parameters.stainArea * this.Area
+
+ 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
+ float32 rbcRadiusPx
+
+ let mutable parameters: Parameters = param
+ let mutable rbcRadiusByResolution = RBCRadius(RBCadiusInPixels parameters.rbcDiameter parameters.resolution, parameters)
+ let mutable rbcRadius = RBCRadius(0.f, parameters)
+
+ new () = Config(defaultParameters)
+
+ member this.Parameters
+ with get() = parameters
+ and set(param) =
+ parameters <- param
+ rbcRadiusByResolution <- RBCRadius(RBCadiusInPixels parameters.rbcDiameter parameters.resolution, param)
+ rbcRadius <- RBCRadius(rbcRadius.Pixel, param)
+
+ member val Debug = DebugOff with get, set
+
+ member this.LPFStandardDeviation =
+ let stdDeviation: float<px> = (μmToInch parameters.LPFStandardDeviation) * parameters.resolution
+ float stdDeviation
+
+ member this.RBCRadiusByResolution = rbcRadiusByResolution
+ member this.RBCRadius = rbcRadius
+
+ member this.SetRBCRadius (radiusPixel: float32) =
+ rbcRadius <- RBCRadius(radiusPixel, parameters)
+
+ member this.Copy () =
+ this.MemberwiseClone() :?> Config
+
--- /dev/null
+module ParasitemiaCore.Const
+
+let PI = float32 System.Math.PI
\ No newline at end of file
--- /dev/null
+module ParasitemiaCore.EEOver
+
+open System
+
+let private EPS = 1.0e-5
+
+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 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
+
+ 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
+
+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 x =
+ if abs x > a1
+ then
+ if x < 0.0 then -a1 else a1
+ else x
+
+ let theta =
+ if y < 0.0
+ then 2.0 * Math.PI - acos (x / a1)
+ else acos (x / a1)
+
+ let eps_radian = 0.1
+
+ let x1 = a1 * cos (theta + eps_radian)
+ let y1 = b1 * sin (theta + eps_radian)
+ let x2 = a1 * cos (theta - eps_radian)
+ let y2 = b1 * sin (theta - eps_radian)
+
+ let test1 = ellipse2tr x1 y1 aa bb cc dd ee ff
+ let test2 = ellipse2tr x2 y2 aa bb cc dd ee ff
+
+#if DEBUG_LOG
+ printf "\t\t--- debug istanpt with (x,y)=(%f, %f), A1=%f, B1=%f\n" x y a1 b1
+ printf "theta=%f\n" theta
+ printf "eps_Radian=%f\n" eps_radian
+ printf "(x1, y1)=(%f, %f)\n" x1 y1
+ printf "(x2, y2)=(%f, %f)\n" x2 y2
+ printf "test1=%f\n" test1
+ printf "test2=%f\n" test2
+#endif
+
+ 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 mutable theta1 =
+ 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
+
+ let mutable theta2 =
+ if y.[1] < 0.0
+ then 2.0 * Math.PI - acos (x.[1] / a1)
+ else acos (x.[1] / a1)
+
+ 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
+ let tmp = theta1
+ theta1 <- theta2
+ theta2 <- tmp
+
+ 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 DEBUG_LOG
+ printf "TWO area1=%f\n" area1
+#endif
+ area1 <- area1 + a1 * b1
+
+ let cosphi = cos (phi_1 - phi_2)
+ let sinphi = sin (phi_1 - phi_2)
+
+ let mutable x1_tr = (x.[0] - h2_tr) * cosphi + (y.[0] - k2_tr) * -sinphi
+ let mutable y1_tr = (x.[0] - h2_tr) * sinphi + (y.[0] - k2_tr) * cosphi
+ 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
+ x1_tr <- if x1_tr < 0.0 then -a2 else a2
+
+ 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
+ x2_tr <- if x2_tr < 0.0 then -a2 else a2
+
+ 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
+ let tmp = theta1
+ theta1 <- theta2
+ theta2 <- tmp
+
+ let xmid = a2 * cos ((theta1 + theta2) / 2.0)
+ let ymid = b2 * sin ((theta1 + theta2) / 2.0)
+
+ let cosphi = cos (phi_2 - phi_1)
+ let sinphi = sin (phi_2 - phi_1)
+ 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
+ let tmp = theta1
+ theta1 <- theta2
+ theta2 <- tmp
+
+ 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 DEBUG_LOG
+ printf "TWO area2=%f\n" area2
+#endif
+ area2 <- area2 + a2 * b2
+
+ 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 mutable tanpts = 0
+ let mutable tanindex = 0
+ for i in 0..2 do
+ 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
+ -1.0
+ else
+ match tanindex with
+ | 0 ->
+ xint.[0] <- xint.[2]
+ yint.[0] <- yint.[2]
+ | 1 ->
+ xint.[1] <- xint.[2]
+ yint.[1] <- yint.[2]
+ | _ ->
+ ()
+ 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 a1b1 = a1 * b1
+ let a2b2 = a2 * b2
+ let area_1 = Math.PI * a1b1
+ let area_2 = Math.PI * a2b2
+
+ let theta = Array.zeroCreate 4
+
+ for i in 0 .. 3 do
+ 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)
+
+#if DEBUG_LOG
+ for k in 0..3 do
+ printf "k=%d: Theta = %f, xint=%f, yint=%f\n" k theta.[k] xint.[k] yint.[k]
+#endif
+
+ for j in 1 .. 3 do
+ let tmp0 = theta.[j]
+ let tmp1 = xint.[j]
+ let tmp2 = yint.[j]
+
+ let mutable k = j - 1
+ let mutable k2 = 0
+ while k >= 0 do
+ if theta.[k] <= tmp0
+ then
+ k2 <- k + 1
+ k <- -1
+ else
+ theta.[k+1] <- theta.[k]
+ xint.[k+1] <- xint.[k]
+ yint.[k+1] <- yint.[k]
+ k <- k - 1
+ k2 <- k + 1
+
+ theta.[k2] <- tmp0
+ xint.[k2] <- tmp1
+ yint.[k2] <- tmp2
+
+
+#if DEBUG_LOG
+ printf "AFTER sorting\n"
+ for k in 0..3 do
+ printf "k=%d: Theta = %f, xint=%f, yint=%f\n" k theta.[k] xint.[k] yint.[k]
+#endif
+
+ let area1 = 0.5 * abs ((xint.[2] - xint.[0]) * (yint.[3] - yint.[1]) - (xint.[3] - xint.[1]) * (yint.[2] - yint.[0]))
+
+ let cosphi = cos (phi_1 - phi_2)
+ let sinphi = sin (phi_1 - phi_2)
+
+ let theta_tr = Array.zeroCreate 4
+ let xint_tr = Array.zeroCreate 4
+ let yint_tr = Array.zeroCreate 4
+
+ for i in 0..3 do
+ 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
+ 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 xmid = a1 * cos ((theta.[0] + theta.[1]) / 2.0)
+ let ymid = b1 * sin ((theta.[0] + theta.[1]) / 2.0)
+
+ 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
+ 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
+ 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]))
+ else
+ area2 <- 0.5 * (a1b1 * (theta.[2] - theta.[1]) - abs (xint.[1] * yint.[2] - xint.[2] * yint.[1]))
+ area3 <- 0.5 * (a1b1 * (theta.[0] - (theta.[3] - 2.0 * Math.PI)) - abs (xint.[3] * yint.[0] - xint.[0] * yint.[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 DEBUG_LOG
+ printf "\n\t\t-------------> area5 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area5 area_2
+#endif
+ area5 <- area5 + area_2
+
+ if area4 < 0.0
+ then
+#if DEBUG_LOG
+ printf "\n\t\t-------------> area4 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area4 area_2
+#endif
+ area4 <- area4 + area_2
+
+ if area3 < 0.0
+ then
+#if DEBUG_LOG
+ printf "\n\t\t-------------> area3 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area3 area_1
+#endif
+ area3 <- area3 + area_1
+
+ if area2 < 0.0
+ then
+#if DEBUG_LOG
+ printf "\n\t\t-------------> area2 is negativ (%f). Add: pi*A2*B2=%f <------------\n" area2 area_1
+#endif
+ area2 <- area2 + area_1
+
+#if DEBUG_LOG
+ printf "\narea1=%f, area2=%f area3=%f, area4=%f, area5=%f\n\n" area1 area2 area3 area4 area5
+#endif
+
+ area1 + area2 + area3 + area4 + area5
+
+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
+ b <- sqrt d + b
+ r.[1, 2] <- b
+ else
+ b <- -sqrt d + b
+ r.[1, 2] <- b
+ r.[1, 1] <- c / b
+ r.[2, 1] <- 0.0
+ r.[2, 2] <- 0.0
+ else
+ d <- sqrt -d
+ r.[2, 1] <- d
+ r.[2, 2] <- -d
+ r.[1, 1] <- b
+ r.[1, 2] <- b
+
+let private cubicroots (p: float[]) (r: float[,]) =
+ if p.[0] <> 1.0 then
+ for k in 1..3 do
+ p.[k] <- p.[k] / p.[0]
+ p.[0] <- 1.0
+ let s = p.[1] / 3.0
+ let mutable t = s * p.[1]
+ let mutable b = 0.5 * (s * (t / 1.5 - p.[2]) + p.[3])
+ t <- (t - p.[2]) / 3.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
+ 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
+ r.[1, 1] <- c
+ r.[2, 1] <- -d
+ r.[1, 3] <- b - s
+ r.[2, 3] <- 0.0
+ else
+ r.[1, 1] <- b - s
+ r.[2, 1] <- 0.0
+ 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 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
+ d <- -t - c - s
+ c <- c - s
+ t <- t - s
+
+ if abs c > abs t
+ then
+ r.[1, 3] <- c
+ else
+ r.[1, 3] <- t
+ t <- c
+
+ if abs d > abs t
+ then
+ r.[1, 2] <- d
+ else
+ r.[1, 2] <- t
+ t <- d
+
+ r.[1, 1] <- t
+ for k in 1..3 do
+ r.[2, k] <- 0.0
+
+let private biquadroots (p: float[]) (r: float[,]) =
+ if p.[0] <> 1.0
+ then
+ for k in 1..4 do
+ p.[k] <- p.[k] / p.[0]
+ p.[0] <- 1.0
+ let e = 0.25 * p.[1]
+ let mutable b = 2.0 * e
+ let mutable c = b ** 2.0
+ let mutable d = 0.75 * c
+ b <- p.[3] + b *(c - p.[2])
+ let mutable a = p.[2] - d
+ c <- p.[4] + e * (e * a - p.[3])
+ a <- a - d
+
+ let mutable quadExecuted = false
+ let inline quad () =
+ if not quadExecuted
+ then
+ p.[2] <- c / b
+ quadroots p r
+ for k in 1..2 do
+ for j in 1..2 do
+ r.[j, k+2] <- r.[j, k]
+ p.[1] <- -p.[1]
+ p.[2] <- b
+ quadroots p r
+ for k in 1..4 do
+ r.[1,k] <- r.[1,k] - e
+ quadExecuted <- true
+
+ 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
+ cubicroots p r
+ let mutable k = 1
+ while k < 4 do
+ 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
+ p.[1] <- sqrt d
+ elif a <= 0.0 && b <= 0.0
+ then
+ p.[1] <- sqrt d
+ else
+ p.[1] <- -(sqrt d)
+ b <- 0.5 * (a + b / p.[1])
+ quad ()
+ k <- 4
+ k <- k + 1
+
+ if not quadExecuted && p.[2] < 0.0
+ then
+ b <- sqrt c
+ d <- b + b - a
+ p.[1] <- 0.0
+ if d > 0.0
+ then
+ p.[1] <- sqrt d
+ 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
+ p.[1] <- 0.0
+ else
+ for k in 1..4 do
+ r.[1, k] <- -e
+ r.[2, k] <- 0.0
+ quadExecuted <- true
+
+ quad ()
+
+// Return a tuple (area, x intersections, y intersections)
+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
+ None
+ else
+ let phi_1 = phi_1 % Math.PI //(if phi_1 > Math.PI / 2.0 then phi_1 - Math.PI else phi_1) % Math.PI
+ let phi_2 = phi_2 % Math.PI //(if phi_2 > Math.PI / 2.0 then phi_2 - Math.PI else phi_2) % Math.PI
+ let h2_tr, k2_tr, phi_2r =
+ let cosphi = cos phi_1
+ let sinphi = sin phi_1
+ (h2 - h1) * cosphi + (k2 - k1) * sinphi, (h1 - h2) * sinphi + (k2 - k1) * cosphi, (phi_2 - phi_1) % (2.0 * Math.PI)
+
+#if DEBUG_LOG
+ printf "H2_TR=%f, K2_TR=%f, PHI_2R=%f\n" h2_tr k2_tr phi_2r
+#endif
+
+ let cosphi = cos phi_2r
+ let cosphi2 = cosphi ** 2.0
+ let sinphi = sin phi_2r
+ let sinphi2 = sinphi ** 2.0
+ let cosphisinphi = 2.0 * cosphi * sinphi
+ let a22 = a2 ** 2.0
+ let b22 = b2 ** 2.0
+ let tmp0 = (cosphi * h2_tr + sinphi * k2_tr) / a22
+ let tmp1 = (sinphi * h2_tr - cosphi * k2_tr) / b22
+ let tmp2 = cosphi * h2_tr + sinphi * k2_tr
+ let tmp3 = sinphi * h2_tr - cosphi * k2_tr
+
+ let aa = cosphi2 / a22 + sinphi2 / b22
+ let bb = cosphisinphi / a22 - cosphisinphi / b22
+ let cc = sinphi2 / a22 + cosphi2 / b22
+ let dd = -2.0 * cosphi * tmp0 - 2.0 * sinphi * tmp1
+ let ee = -2.0 * sinphi * tmp0 + 2.0 * cosphi * tmp1
+ let ff = tmp2 * tmp2 / a22 + tmp3 * tmp3 / b22 - 1.0
+
+ let cy = [|
+ (a1 * (a1 * aa - dd) + ff) * (a1 * (a1 * aa + dd) + ff)
+ 2.0 * b1 * (a1 * a1 * (aa * ee - bb * dd) + ee * ff)
+ a1 * a1 * ((b1 * b1 * (2.0 * aa * cc - bb * bb) + dd * dd - 2.0 * aa * ff) - 2.0 * a1 * a1 * aa * aa) + b1 * b1 * (2.0 * cc * ff + ee * ee)
+ 2.0 * b1 * (b1 * b1 * cc * ee + a1 * a1 * (bb * dd - aa * ee))
+ a1 * a1 * a1 * a1 * aa * aa + b1 * b1 * (a1 * a1 * (bb * bb - 2.0 * aa * cc) + b1 * b1 * cc * cc)
+ |]
+
+#if DEBUG_LOG
+ for i in 0..4 do
+ printf "cy[%d]=%f\n" i cy.[i]
+#endif
+
+ let py = Array.zeroCreate<float> 5
+ let r = Array2D.zeroCreate<float> 3 5
+
+ let nroots =
+ if abs cy.[4] > EPS
+ then
+ for i in 0 .. 3 do
+ py.[4-i] <- cy.[i] / cy.[4]
+ py.[0] <- 1.0
+#if DEBUG_LOG
+ for i in 0..4 do
+ printf "py[%d]=%f\n" i py.[i]
+#endif
+ biquadroots py r
+ 4
+
+ elif abs cy.[3] > EPS
+ then
+ for i in 0..2 do
+ py.[3 - i] <- cy.[i] / cy.[3]
+ py.[0] <- 1.0
+ cubicroots py r
+ 3
+
+ elif abs cy.[2] > EPS
+ then
+ for i in 0..1 do
+ py.[2-i] <- cy.[i] / cy.[2]
+ py.[0] <- 1.0
+ quadroots py r
+ 2
+
+ elif abs cy.[1] > EPS
+ then
+ r.[1, 1] <- -cy.[0] / cy.[1]
+ r.[2, 1] <- 0.0
+ 1
+
+ else
+ 0
+
+#if DEBUG_LOG
+ printf "nroots = %d\n" nroots
+#endif
+
+ let ychk = Array.init nroots (fun _ -> Double.MaxValue)
+ let mutable nychk = 0
+ for i in 1 .. nroots do
+ if abs r.[2, i] < EPS
+ then
+ ychk.[nychk] <- r.[1, i] * b1
+ nychk <- nychk + 1
+#if DEBUG_LOG
+ printf "ROOT is Real, i=%d --> %f (B1=%f)\n" i r.[1, i] b1
+#endif
+ Array.sortInPlace ychk
+
+#if DEBUG_LOG
+ printf "nychk=%d\n" ychk.Length
+ for j in 0 .. ychk.Length - 1 do
+ printf "\t j=%d, ychk=%f\n" j ychk.[j]
+#endif
+
+ let mutable nintpts = 0
+
+ let xint = Array.zeroCreate 4
+ let yint = Array.zeroCreate 4
+
+ let mutable returnValue = 0.0
+
+ let mutable i = 0
+ while returnValue = 0.0 && i < nychk do
+#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 DEBUG_LOG
+ printf "check intersecting points. nintps is %d" nintpts
+#endif
+
+ let x1 = if abs ychk.[i] > b1 then 0.0 else a1 * sqrt (1.0 - (ychk.[i] * ychk.[i]) / (b1 * b1))
+ let x2 = -x1
+
+#if DEBUG_LOG
+ printf "\tx1=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x1)= %f\n" x1 ychk.[i] a1 b1 (ellipse2tr x1 ychk.[i] aa bb cc dd ee ff)
+ printf "\tx2=%f, y1=%f, A=%f. B=%f ---> ellipse2tr(x2) %f\n" x2 ychk.[i] a1 b1 (ellipse2tr x2 ychk.[i] aa bb cc dd ee ff)
+#endif
+
+ 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
+ returnValue <- -1.0
+ else
+ xint.[nintpts-1] <- x1
+ yint.[nintpts-1] <- ychk.[i]
+#if DEBUG_LOG
+ 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
+ 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
+ returnValue <- -1.0
+ else
+ xint.[nintpts-1] <- x2
+ yint.[nintpts-1] <- ychk.[i]
+
+#if DEBUG_LOG
+ printf "nintpts=%d, x1=%f, xint=%f, i=%d, yint=%f\n" nintpts x1 x2 i ychk.[i]
+#endif
+
+#if DEBUG_LOG
+ else
+ printf "i=%d, multiple roots: %f <--------> %f. continue\n" i ychk.[i] ychk.[i-1]
+#endif
+ i <- i + 1
+
+
+ if returnValue = -1.0
+ then
+ None
+ else
+ let area =
+ match nintpts with
+ | 0 | 1 -> nointpts a1 b1 a2 b2 h1 k1 h2 k2 phi_1 phi_2 h2_tr k2_tr aa bb cc dd ee ff
+ | 2 -> match istanpt xint.[0] yint.[0] a1 b1 aa bb cc dd ee ff with
+ | TANGENT_POINT ->
+#if DEBUG_LOG
+ printf "one point is tangent\n"
+#endif
+ nointpts a1 b1 a2 b2 h1 k1 h2 k2 phi_1 phi_2 h2_tr k2_tr aa bb cc dd ee ff
+
+ | INTERSECTION_POINT ->
+#if DEBUG_LOG
+ printf "check twointpts\n"
+#endif
+ twointpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
+ | 3 -> threeintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
+ | 4 -> fourintpts xint yint a1 b1 phi_1 a2 b2 h2_tr k2_tr phi_2 aa bb cc dd ee ff
+ | _ -> -1.0
+ if nintpts = 0
+ then Some (float32 area, [||], [||])
+ else
+ let xTransform : float32[] = Array.zeroCreate nintpts
+ let yTransform : float32[] = Array.zeroCreate nintpts
+ for i in 0 .. (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
--- /dev/null
+module ParasitemiaCore.Ellipse
+
+open System
+open System.Collections.Generic
+open System.Drawing
+
+open MathNet.Numerics.LinearAlgebra
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Utils
+open Config
+open MatchingEllipses
+open Const
+
+type private SearchExtremum = Minimum | Maximum
+
+let private goldenSectionSearch (f: float -> float) (nbIter: int) (xmin: float) (xmax: float) (searchExtremum: SearchExtremum) : (float * float) =
+ let gr = 1. / 1.6180339887498948482
+ let mutable a = xmin
+ let mutable b = xmax
+ let mutable c = b - gr * (b - a)
+ let mutable d = a + gr * (b - a)
+
+ for i in 1 .. nbIter do
+ let mutable fc = f c
+ let mutable fd = f d
+
+ if searchExtremum = Maximum
+ then
+ let tmp = fc
+ fc <- fd
+ fd <- tmp
+
+ if fc < fd
+ then
+ b <- d
+ d <- c
+ c <- b - gr * (b - a)
+ else
+ a <- c
+ c <- d
+ d <- a + gr * (b - a)
+
+ let x = (b + a) / 2.
+ x, f x
+
+// Ellipse.A is always equal or greater than Ellipse.B.
+// Ellipse.Alpha is between 0 and Pi.
+let ellipse (p1x: float) (p1y: float) (m1: float) (p2x: float) (p2y: float) (m2: float) (p3x: float) (p3y: float) : Types.Ellipse option =
+ let accuracy_extremum_search_1 = 10 // 3
+ let accuracy_extremum_search_2 = 10 // 4
+
+ // p3 as the referencial.
+ let p1x = p1x - p3x
+ let p1y = p1y - p3y
+
+ let p2x = p2x - p3x
+ let p2y = p2y - p3y
+
+ // Convert to polar coordinates.
+ let alpha1 = atan m1
+ let alpha2 = atan m2
+
+ let r1 = sqrt (p1x ** 2. + p1y ** 2.)
+ let theta1 = atan2 p1y p1x
+
+ let r2 = sqrt (p2x ** 2. + p2y ** 2.)
+ let theta2 = atan2 p2y p2x
+
+ let valid =
+ 4. * sin (alpha1 - theta1) * (-r1 * sin (alpha1 - theta1) + r2 * sin (alpha1 - theta2)) *
+ sin (alpha2 - theta2) * (-r1 * sin (alpha2 - theta1) + r2 * sin (alpha2 - theta2)) +
+ r1 * r2 * sin (alpha1 - alpha2) ** 2. * sin (theta1 - theta2) ** 2. < 0.
+
+ if valid
+ then
+ let r theta =
+ (r1 * r2 * (r1 * (cos (alpha2 + theta - theta1 - theta2) - cos (alpha2 - theta) * cos (theta1 - theta2)) * sin (alpha1 - theta1) + r2 * (-cos (alpha1 + theta - theta1 - theta2) + cos (alpha1 - theta) * cos (theta1 - theta2)) * sin (alpha2 - theta2)) * sin (theta1 - theta2)) /
+ (sin (alpha1 - theta1) * sin (alpha2 - theta2) * (r1 * sin (theta - theta1) - r2 * sin (theta - theta2)) ** 2. - r1 * r2 * sin (alpha1 - theta) * sin (alpha2 - theta) * sin (theta1 - theta2) ** 2.)
+
+ let rabs = r >> abs
+
+ // We search for an interval [theta_a, theta_b] and assume the function is unimodal in this interval.
+ let thetaTan, _ = goldenSectionSearch rabs accuracy_extremum_search_1 0. Math.PI Maximum
+ let rTan = r thetaTan
+
+ let PTanx = rTan * cos thetaTan
+ let PTany = rTan * sin thetaTan
+
+ let d1a = tan alpha1
+ let d1b = -d1a * p1x + p1y
+
+ let d2a = tan alpha2
+ let d2b = -d2a * p2x + p2y
+
+ let d3a = -1. / tan thetaTan
+ let d3b = -d3a * PTanx + PTany
+
+ let Ux = -(d1b - d2b) / (d1a - d2a)
+ let Uy = -(d2a * d1b - d1a * d2b) / (d1a - d2a)
+
+ let Vx = -(d1b - d3b) / (d1a - d3a)
+ let Vy = -(d3a * d1b - d1a * d3b) / (d1a - d3a)
+
+ let Wx = p1x + (p2x - p1x) / 2.
+ let Wy = p1y + (p2y - p1y) / 2.
+
+ let Zx = p1x + (PTanx - p1x) / 2.
+ let Zy = p1y + (PTany - p1y) / 2.
+
+ let va = -(-Vy + Zy) / (Vx - Zx)
+ let vb = -(Zx * Vy - Vx * Zy) / (Vx - Zx)
+
+ let ua = -(-Uy + Wy) / (Ux - Wx)
+ let ub = -(Wx * Uy - Ux * Wy) / (Ux - Wx)
+
+ let cx = -(vb - ub) / (va - ua)
+ let cy = -(ua * vb - va * ub) / (va - ua)
+
+ let rc = sqrt (cx ** 2. + cy ** 2.)
+ let psi = atan2 cy cx
+
+ let rellipse theta =
+ sqrt (
+ rc ** 2. + (r1 ** 2. * r2 ** 2. * (r1 * (cos (alpha2 + theta - theta1 - theta2) - cos (alpha2 - theta) * cos (theta1 - theta2)) * sin (alpha1 - theta1) + r2 * (-cos (alpha1 + theta - theta1 - theta2) + cos (alpha1 - theta) * cos (theta1 - theta2)) * sin (alpha2 - theta2)) ** 2. * sin (theta1 - theta2) ** 2.) /
+ (sin (alpha1 - theta1) * sin (alpha2 - theta2) * (r1 * sin (theta - theta1) - r2 * sin (theta - theta2)) ** 2. - r1 * r2 * sin (alpha1 - theta) * sin (alpha2 - theta) * sin (theta1 - theta2) ** 2.) ** 2. -
+ (2. * r1 * r2 * rc * cos (theta - psi) * (r1 * (cos (alpha2 + theta - theta1 - theta2) - cos (alpha2 - theta) * cos (theta1 - theta2)) * sin (alpha1 - theta1) + r2 * (-cos (alpha1 + theta - theta1 - theta2) + cos (alpha1 - theta) * cos (theta1 - theta2)) * sin (alpha2 - theta2)) * sin (theta1 - theta2)) /
+ (sin (alpha1 - theta1) * sin (alpha2 - theta2) * (r1 * sin (theta - theta1) - r2 * sin (theta - theta2)) ** 2. - r1 * r2 * sin (alpha1 - theta) * sin (alpha2 - theta) * sin (theta1 - theta2) ** 2.))
+
+ // We search for an interval [theta_a, theta_b] and assume the function is unimodal in this interval.
+ let r1eTheta, r1e = goldenSectionSearch rellipse accuracy_extremum_search_2 0. (Math.PI / 2.) Maximum // Pi/2 and not pi because the period is Pi.
+ let r2eTheta, r2e = goldenSectionSearch rellipse accuracy_extremum_search_2 0. (Math.PI / 2.) Minimum
+
+ let rr1e = r r1eTheta
+ let r1ex = rr1e * cos r1eTheta
+ let r1ey = rr1e * sin r1eTheta
+ let mutable alpha = atan ((r1ey - cy) / (r1ex - cx))
+ if alpha < 0.
+ then
+ alpha <- alpha + Math.PI
+
+ // Ride off the p3 referential.
+ let cx = cx + p3x
+ let cy = cy + p3y
+
+ Some (Types.Ellipse(float32 cx, float32 cy, float32 r1e, float32 r2e, float32 alpha))
+ else
+ None
+
+let ellipse2 (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 v0 = matrix [[ 1.; p0x; p0y ]]
+ let v1 = matrix [[ 1.; p1x; p1y ]]
+ let v2 = matrix [[ 1.; p2x; p2y ]]
+ let v3 = matrix [[ 1.; p3x; p3y ]]
+
+ let p = (v3.Stack(v1).Stack(v2).Determinant() * v0).Stack(v0.Stack(v3).Stack(v2).Determinant() * v1).Stack(v0.Stack(v1).Stack(v3).Determinant() * v2).Transpose()
+ let conicMat = p * s.Inverse() * p.Transpose()
+ let a = conicMat.[0, 0]
+ let b = conicMat.[0, 1]
+ let c = conicMat.[1, 1]
+ let d = conicMat.[0, 2]
+ let e = conicMat.[1, 2]
+ let f = conicMat.[2, 2]
+
+ // Center.
+ let cx = b / a
+ let cy = d / a
+
+ let at = c * f - e ** 2. + (e * d - b * f) * cx + (b * e - c * d) * cy
+ 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 eigen = q.Evd()
+ let eigenValues = eigen.EigenValues
+ let lambda = eigenValues.[1].Real
+ let mu = eigenValues.[0].Real
+
+ if lambda <= 0. || mu <= 0.
+ then
+ None
+ else
+ let r1, r2 = 1. / (sqrt lambda), 1. / (sqrt mu)
+
+ let eigenVectors = eigen.EigenVectors
+ let v_a = eigenVectors.[0, 0]
+ let v_b = eigenVectors.[1, 0] // [0, 1]
+
+ // Angle against the longest axis.
+ let phi = (if r2 > r1 then atan (v_b / v_a) else atan (v_a / v_b))
+
+ let phi' = if phi < 0. then phi + Math.PI else phi
+ let majorAxis, minorAxis = if r1 > r2 then r1, r2 else r2, r1
+
+ Some (Types.Ellipse(float32 cx, float32 cy, float32 majorAxis, float32 minorAxis, float32 phi'))
+
+
+let private vectorRotation (p1x: float32) (p1y: float32) (v1x: float32) (v1y: float32) (px: float32) (py: float32) : float32 =
+ let mutable rotation = 1.f
+ if p1y > py
+ then
+ if v1x > 0.f
+ then
+ rotation <- -1.f
+ elif p1y < py
+ then
+ if v1x < 0.f
+ then
+ rotation <- -1.f
+ elif p1x > px
+ then
+ if v1y < 0.f
+ then
+ rotation <- -1.f
+ elif p1x < px
+ then
+ if v1y > 0.f
+ then
+ rotation <- -1.f
+ rotation
+
+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 b1 = -m1 * p1x + p1y
+ let b2 = -m2 * p2x + p2y
+ let px = -((b1 - b2) / (m1 - m2))
+ let py = -((m2 * b1 - m1 * b2) / (m1 - m2))
+
+ let rot1 = vectorRotation p1x p1y v1x v1y px py
+ let rot2 = vectorRotation p2x p2y v2x v2y px py
+
+ if rot1 = rot2
+ then
+ None
+ else
+ let alpha1 = atan2 (p1y - py) (p1x - px)
+ let alpha2 = atan2 (p2y - py) (p2x - px)
+
+ let alpha1' = if alpha1 < 0.f then 2.f * PI + alpha1 else alpha1
+ let alpha2' = if alpha2 < 0.f then 2.f * PI + alpha2 else alpha2
+
+ let diff = rot1 * alpha1' + rot2 * alpha2'
+
+ if diff > PI || (diff < 0.f && diff > -PI)
+ then
+ None
+ else
+ Some (m1, m2)
+
+
+let find (edges: Matrix<byte>)
+ (xGradient: Image<Gray, float32>)
+ (yGradient: Image<Gray, float32>)
+ (config: Config) : MatchingEllipses =
+
+ let r1, r2 = config.RBCRadius.Min, config.RBCRadius.Max
+ let incrementWindowDivisor = 4.f
+
+ // We choose a window size for which the biggest ellipse can always be fitted in.
+ let windowSize = roundInt (2.f * r2 / (incrementWindowDivisor - 1.f) * incrementWindowDivisor)
+ let factorNbPick = config.Parameters.factorNbPick
+
+ let increment = windowSize / (int incrementWindowDivisor)
+
+ let radiusTolerance = (r2 - r1) * 0.2f
+
+ let squaredMinimumDistance = (float r2 / 1.5) ** 2.
+ let inline squaredDistance x1 y1 x2 y2 = (x1 - x2) ** 2. + (y1 - y2) ** 2.
+
+ let h = edges.Height
+ let w = edges.Width
+ let h_f = float32 h
+ let w_f = float32 w
+
+ let mutable last_i, last_j = Int32.MaxValue, Int32.MaxValue
+
+ let currentElements = List<Point>()
+
+ let edgesData = edges.Data
+ let xDirData = xGradient.Data
+ let yDirData = yGradient.Data
+
+ let rng = Random(42)
+
+ let ellipses = MatchingEllipses(config.RBCRadius.Pixel)
+
+ for window_i in -windowSize + increment .. increment .. h - increment do
+ for window_j in -windowSize + increment .. increment .. w - increment do
+
+ let window_i_begin = if window_i < 0 then 0 else window_i
+ let window_i_end = if window_i + windowSize - 1 >= h then h - 1 else window_i + windowSize - 1
+ let window_j_begin = if window_j < 0 then 0 else window_j
+ let window_j_end = if window_j + windowSize - 1 >= w then w - 1 else window_j + windowSize - 1
+
+ // Remove old elements.
+ let indexFirstElement = currentElements.FindIndex(fun p -> p.X >= window_j_begin)
+ 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 in (if newElemsBegin_j < 0 then 0 else newElemsBegin_j) .. (if newElemsEnd_j >= w then w - 1 else newElemsEnd_j) do
+ for i in window_i_begin .. window_i_end do
+ if edgesData.[i, j] = 1uy
+ then currentElements.Add(Point(j, i))
+
+ if currentElements.Count >= 10
+ then
+ let mutable nbOfPicks = (float currentElements.Count) * factorNbPick |> int
+ while nbOfPicks > 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
+ nbOfPicks <- nbOfPicks - 1
+ let p1yf, p1xf = float p1.Y, float p1.X
+ let p2yf, p2xf = float p2.Y, float p2.X
+ let p3yf, p3xf = float p3.Y, float p3.X
+ if squaredDistance p1xf p1yf p2xf p2yf >= squaredMinimumDistance &&
+ squaredDistance p1xf p1yf p3xf p3yf >= squaredMinimumDistance &&
+ squaredDistance p2xf p2yf p3xf p3yf >= squaredMinimumDistance
+ then
+ match areVectorsValid (float32 p1xf) (float32 p1yf) (float32 p2xf) (float32 p2yf) -xDirData.[p1.Y, p1.X, 0] -yDirData.[p1.Y, p1.X, 0] -xDirData.[p2.Y, p2.X, 0] -yDirData.[p2.Y, p2.X, 0] with
+ | Some (m1, m2) ->
+ //let pouet = ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf
+ match ellipse2 p1xf p1yf (float m1) p2xf p2yf (float m2) p3xf p3yf with
+ | Some e when e.Cx > 0.f && e.Cx < w_f - 1.f && e.Cy > 0.f && e.Cy < h_f - 1.f &&
+ e.A >= r1 - radiusTolerance && e.A <= r2 + radiusTolerance && e.B >= r1 - radiusTolerance && e.B <= r2 + radiusTolerance ->
+ ellipses.Add e
+ | _ -> ()
+ | _ -> ()
+
+ currentElements.Clear()
+
+ ellipses
+
--- /dev/null
+module ParasitemiaCore.Granulometry
+
+open System
+open System.Drawing
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Utils
+
+// 'range': a minimum and maximum radius.
+// 'scale': <= 1.0, to speed up the process.
+let findRadiusByClosing (img: Image<Gray, 'TDepth>) (range: int * int) (scale: float) : int =
+ use scaledImg = if scale = 1. then img else img.Resize(scale, CvEnum.Inter.Area)
+
+ let r1, r2 = range
+ let r1', r2' = roundInt (float r1 * scale), roundInt (float r2 * scale)
+
+ let patternSpectrum = Array.zeroCreate (r2' - r1')
+ let intensityImg = scaledImg.GetSum().Intensity
+
+ // 's' must be odd.
+ 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 in 0 .. r - 1 do
+ for j in 0 .. r - 1 do
+ if i + j < r
+ then
+ m.[i, j] <- 0uy
+ m.[s - i - 1, j] <- 0uy
+ m.[i, s - j - 1] <- 0uy
+ m.[s - i - 1, s - j - 1] <- 0uy
+ m
+
+ let mutable previous_n = Double.NaN
+ for r in r1' .. r2' do
+ let se = CvInvoke.GetStructuringElement(CvEnum.ElementShape.Ellipse, Size(2 * r, 2 * r), Point(-1, -1))
+ //let se = octagon (2 * r - 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
+ patternSpectrum.[r - r1' - 1] <- abs (n - previous_n)
+ previous_n <- n
+
+ let max, _ = patternSpectrum |> Array.indexed |> Array.fold (fun (iMax, sMax) (i, s) -> if s > sMax then (i, s) else (iMax, sMax)) (0, Double.MinValue)
+
+ float (max + r1') / scale |> roundInt
+
+let findRadiusByAreaClosing (img: Image<Gray, float32>) (range: int * int) : int =
+ let r1, r2 = range
+
+ use imgCopy = img.Copy()
+
+ let mutable maxDiff = 0.f
+ let mutable max_r = r1
+
+ ImgTools.areaCloseFWithFun imgCopy [ for r in r1 .. r2 -> Math.PI * float r ** 2. |> roundInt, r ] (fun r diff ->
+ if r <> r1 && diff > maxDiff
+ then
+ maxDiff <- diff
+ max_r <- r - 1 )
+ max_r
+
--- /dev/null
+module ParasitemiaCore.Heap
+
+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)
+
+[<Struct>]
+type private Node<'k, '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
+
+type Heap<'k, 'v> (kComparer : IComparer<'k>) =
+ let a = List<Node<'k, 'v>>()
+
+ 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
+ max <- r
+
+ // If a child is greater than the parent.
+ 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 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
+ else
+ true
+ let rightIntegrity =
+ if r < a.Count
+ then
+ if kComparer.Compare(a.[r].key, a.[i].key) > 0
+ then false
+ else checkIntegrity r
+ else
+ true
+ leftIntegrity && rightIntegrity
+
+ interface IEnumerable<'k * 'v> with
+ member this.GetEnumerator () : IEnumerator<'k * 'v> =
+ (seq { for e in a -> e.key, e.value }).GetEnumerator()
+
+ interface System.Collections.IEnumerable with
+ member this.GetEnumerator () : System.Collections.IEnumerator =
+ (this :> IEnumerable<'k * 'v>).GetEnumerator() :> System.Collections.IEnumerator
+
+ member this.Next () : 'k * 'v =
+ let node = a.[0]
+ a.[0] <- a.[a.Count - 1]
+ a.RemoveAt(a.Count - 1)
+ heapUp 0
+ node.key, node.value
+
+ member this.RemoveNext () =
+ a.[0] <- a.[a.Count - 1]
+ a.RemoveAt(a.Count - 1)
+ heapUp 0
+
+ member this.Add (key: 'k) (value: 'v) =
+ a.Add(Node(key, value))
+
+ let mutable i = a.Count - 1
+ while i > 0 && kComparer.Compare(a.[parent i].key, a.[i].key) < 0 do
+ let tmp = a.[parent i]
+ a.[parent i] <- a.[i]
+ a.[i] <- tmp
+ i <- parent i
+
+ member this.IsEmpty = a.Count = 0
+ member this.Count = a.Count
+
+ member this.Max : 'k * 'v =
+ let max = a.[0]
+ max.key, max.value
+
+ member this.Clear () = a.Clear()
+
+
--- /dev/null
+module ParasitemiaCore.ImgTools
+
+open System
+open System.Drawing
+open System.Collections.Generic
+open System.Linq
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Heap
+open Const
+open Utils
+
+// Normalize image values between 0uy and 255uy.
+let normalizeAndConvert (img: Image<Gray, 'TDepth>) : Image<Gray, byte> =
+ let min = ref [| 0.0 |]
+ let minLocation = ref <| [| Point() |]
+ let max = ref [| 0.0 |]
+ let maxLocation = ref <| [| Point() |]
+ img.MinMax(min, max, minLocation, maxLocation)
+ ((img.Convert<Gray, float32>() - (!min).[0]) / ((!max).[0] - (!min).[0]) * 255.0).Convert<Gray, byte>()
+
+let saveImg (img: Image<'TColor, 'TDepth>) (filepath: string) =
+ img.Save(filepath)
+
+let saveMat (mat: Matrix<'TDepth>) (filepath: string) =
+ use img = new Image<Gray, 'TDeph>(mat.Size)
+ mat.CopyTo(img)
+ saveImg img filepath
+
+type Histogram = { data: int[]; total: int; sum: int; min: float32; max: float32 }
+
+let histogramImg (img: Image<Gray, float32>) (nbSamples: int) : Histogram =
+ let imgData = img.Data
+
+ let min, max =
+ let min = ref [| 0.0 |]
+ let minLocation = ref <| [| Point() |]
+ let max = ref [| 0.0 |]
+ let maxLocation = ref <| [| Point() |]
+ img.MinMax(min, max, minLocation, maxLocation)
+ float32 (!min).[0], float32 (!max).[0]
+
+ let bin (x: float32) : int =
+ let p = int ((x - min) / (max - min) * float32 nbSamples)
+ if p >= nbSamples then nbSamples - 1 else p
+
+ let data = Array.zeroCreate nbSamples
+
+ for i in 0 .. img.Height - 1 do
+ for j in 0 .. img.Width - 1 do
+ let p = bin imgData.[i, j, 0]
+ data.[p] <- data.[p] + 1
+
+ { data = data; total = img.Height * img.Width; sum = Array.sum data; min = min; max = max }
+
+let histogramMat (mat: Matrix<float32>) (nbSamples: int) : Histogram =
+ let matData = mat.Data
+
+ let min, max =
+ let min = ref 0.0
+ let minLocation = ref <| Point()
+ let max = ref 0.0
+ let maxLocation = ref <| Point()
+ mat.MinMax(min, max, minLocation, maxLocation)
+ float32 !min, float32 !max
+
+ let bin (x: float32) : int =
+ let p = int ((x - min) / (max - min) * float32 nbSamples)
+ if p >= nbSamples then nbSamples - 1 else p
+
+ let data = Array.zeroCreate nbSamples
+
+ for i in 0 .. mat.Height - 1 do
+ for j in 0 .. mat.Width - 1 do
+ let p = bin matData.[i, j]
+ data.[p] <- data.[p] + 1
+
+ { data = data; total = mat.Height * mat.Width; sum = Array.sum data; min = min; max = max }
+
+let histogram (values: float32 seq) (nbSamples: int) : Histogram =
+ let mutable min = Single.MaxValue
+ let mutable max = Single.MinValue
+ let mutable n = 0
+
+ for v in values do
+ n <- n + 1
+ if v < min then min <- v
+ if v > max then max <- v
+
+ let bin (x: float32) : int =
+ let p = int ((x - min) / (max - min) * float32 nbSamples)
+ if p >= nbSamples then nbSamples - 1 else p
+
+ let data = Array.zeroCreate nbSamples
+
+ for v in values do
+ let p = bin v
+ data.[p] <- data.[p] + 1
+
+ { data = data; total = n; sum = Array.sum data; min = min; max = max }
+
+let otsu (hist: Histogram) : float32 * float32 * float32 =
+ let mutable sumB = 0
+ let mutable wB = 0
+ let mutable maximum = 0.0
+ let mutable level = 0
+ let sum = hist.data |> Array.mapi (fun i v -> i * v) |> Array.sum |> float
+
+ for i in 0 .. hist.data.Length - 1 do
+ wB <- wB + hist.data.[i]
+ if wB <> 0
+ then
+ let wF = hist.total - wB
+ 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
+ level <- i
+ maximum <- between
+
+ let mean1 =
+ let mutable sum = 0
+ let mutable nb = 0
+ for i in 0 .. level - 1 do
+ sum <- sum + i * hist.data.[i]
+ nb <- nb + hist.data.[i]
+ (sum + level * hist.data.[level] / 2) / (nb + hist.data.[level] / 2)
+
+ let mean2 =
+ let mutable sum = 0
+ let mutable nb = 0
+ for i in level + 1 .. hist.data.Length - 1 do
+ sum <- sum + i * hist.data.[i]
+ nb <- nb + hist.data.[i]
+ (sum + level * hist.data.[level] / 2) / (nb + hist.data.[level] / 2)
+
+ let toFloat l =
+ float32 l / float32 hist.data.Length * (hist.max - hist.min) + hist.min
+
+ toFloat level, toFloat mean1, toFloat mean2
+
+let suppressMConnections (img: Matrix<byte>) =
+ let w = img.Width
+ let h = img.Height
+ for i in 1 .. h - 2 do
+ for j in 1 .. 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
+ img.[i, j] <- 0uy
+ for i in 1 .. h - 2 do
+ for j in 1 .. 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
+ img.[i, j] <- 0uy
+
+let findEdges (img: Image<Gray, float32>) : Matrix<byte> * Image<Gray, float32> * Image<Gray, float32> =
+ let w = img.Width
+ let h = img.Height
+
+ use sobelKernel =
+ new ConvolutionKernelF(array2D [[ 1.0f; 0.0f; -1.0f ]
+ [ 2.0f; 0.0f; -2.0f ]
+ [ 1.0f; 0.0f; -1.0f ]], Point(1, 1))
+
+ let xGradient = img.Convolution(sobelKernel)
+ let yGradient = img.Convolution(sobelKernel.Transpose())
+
+ let xGradientData = xGradient.Data
+ let yGradientData = yGradient.Data
+ for r in 0 .. h - 1 do
+ xGradientData.[r, 0, 0] <- 0.f
+ xGradientData.[r, w - 1, 0] <- 0.f
+ yGradientData.[r, 0, 0] <- 0.f
+ yGradientData.[r, w - 1, 0] <- 0.f
+
+ for c in 0 .. w - 1 do
+ xGradientData.[0, c, 0] <- 0.f
+ xGradientData.[h - 1, c, 0] <- 0.f
+ yGradientData.[0, c, 0] <- 0.f
+ yGradientData.[h - 1, c, 0] <- 0.f
+
+ use magnitudes = new Matrix<float32>(xGradient.Size)
+ use angles = new Matrix<float32>(xGradient.Size)
+ CvInvoke.CartToPolar(xGradient, yGradient, magnitudes, angles) // Compute the magnitudes (without angles).
+
+ let thresholdHigh, thresholdLow =
+ let sensibilityHigh = 0.1f
+ let sensibilityLow = 0.0f
+ use magnitudesByte = magnitudes.Convert<byte>()
+ let threshold, _, _ = otsu (histogramMat magnitudes 300)
+ threshold + (sensibilityHigh * threshold), threshold - (sensibilityLow * threshold)
+
+ // Non-maximum suppression.
+ use nms = new Matrix<byte>(xGradient.Size)
+
+ let nmsData = nms.Data
+ let anglesData = angles.Data
+ let magnitudesData = magnitudes.Data
+ let xGradientData = xGradient.Data
+ let yGradientData = yGradient.Data
+
+ let PI = float32 Math.PI
+
+ for i in 0 .. h - 1 do
+ nmsData.[i, 0] <- 0uy
+ nmsData.[i, w - 1] <- 0uy
+
+ for j in 0 .. w - 1 do
+ nmsData.[0, j] <- 0uy
+ nmsData.[h - 1, j] <- 0uy
+
+ for i in 1 .. h - 2 do
+ for j in 1 .. w - 2 do
+ let vx = xGradientData.[i, j, 0]
+ let vy = yGradientData.[i, j, 0]
+ 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 m = magnitudesData.[i, j]
+ 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 edges = new Matrix<byte>(xGradient.Size)
+ let edgesData = edges.Data
+
+ // Hysteresis thresholding.
+ let toVisit = Stack<Point>()
+ for i in 0 .. h - 1 do
+ for j in 0 .. w - 1 do
+ if nmsData.[i, j] = 1uy && magnitudesData.[i, j] >= thresholdHigh
+ then
+ nmsData.[i, j] <- 0uy
+ toVisit.Push(Point(j, i))
+ while toVisit.Count > 0 do
+ let p = toVisit.Pop()
+ edgesData.[p.Y, p.X] <- 1uy
+ for i' in -1 .. 1 do
+ for j' in -1 .. 1 do
+ 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
+ nmsData.[ni, nj] <- 0uy
+ toVisit.Push(Point(nj, ni))
+
+ edges, xGradient, yGradient
+
+let gaussianFilter (img : Image<'TColor, 'TDepth>) (standardDeviation : float) : Image<'TColor, 'TDepth> =
+ let size = 2 * int (ceil (4.0 * standardDeviation)) + 1
+ img.SmoothGaussian(size, size, standardDeviation, standardDeviation)
+
+type Points = HashSet<Point>
+
+let drawPoints (img: Image<Gray, 'TDepth>) (points: Points) (intensity: 'TDepth) =
+ for p in points do
+ img.Data.[p.Y, p.X, 0] <- intensity
+
+type ExtremumType =
+ | Maxima = 1
+ | Minima = 2
+
+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 result = List<List<Point>>()
+
+ let flood (start: Point) : List<List<Point>> =
+ let sameLevelToCheck = Stack<Point>()
+ let betterLevelToCheck = Stack<Point>()
+ betterLevelToCheck.Push(start)
+
+ let result' = List<List<Point>>()
+
+ while betterLevelToCheck.Count > 0 do
+ let p = betterLevelToCheck.Pop()
+ if not suppress.[p.Y, p.X]
+ then
+ suppress.[p.Y, p.X] <- true
+ sameLevelToCheck.Push(p)
+ let current = List<Point>()
+
+ let mutable betterExists = false
+
+ while sameLevelToCheck.Count > 0 do
+ let p' = sameLevelToCheck.Pop()
+ let currentLevel = imgData.[p'.Y, p'.X, 0]
+ current.Add(p') |> ignore
+ 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
+ let level = imgData.[ni, nj, 0]
+ let notSuppressed = not suppress.[ni, nj]
+
+ 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
+ betterExists <- true
+ if notSuppressed
+ then
+ betterLevelToCheck.Push(Point(nj, ni))
+
+ if not betterExists
+ then
+ result'.Add(current)
+ result'
+
+ for i in 0 .. h - 1 do
+ for j in 0 .. w - 1 do
+ let maxima = flood (Point(j, i))
+ if maxima.Count > 0
+ then
+ result.AddRange(maxima)
+
+ result.Select(fun l -> Points(l))
+
+let findMaxima (img: Image<Gray, 'TDepth>) : IEnumerable<Points> =
+ findExtremum img ExtremumType.Maxima
+
+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 mutable highest = -1 // Value of the first elements of 'q'.
+ let mutable lowest = size
+
+ member this.NextMax () : byte * Point =
+ if this.IsEmpty
+ then
+ invalidOp "Queue is empty"
+ else
+ let l = q.[highest]
+ let next = l.First()
+ l.Remove(next) |> ignore
+ let value = byte highest
+
+ if l.Count = 0
+ then
+ highest <- highest - 1
+ while highest > lowest && q.[highest].Count = 0 do
+ highest <- highest - 1
+ if highest = lowest
+ then
+ highest <- -1
+ lowest <- size
+
+ value, next
+
+ member this.NextMin () : byte * Point =
+ if this.IsEmpty
+ then
+ invalidOp "Queue is empty"
+ else
+ let l = q.[lowest + 1]
+ let next = l.First()
+ l.Remove(next) |> ignore
+ let value = byte (lowest + 1)
+
+ if l.Count = 0
+ then
+ lowest <- lowest + 1
+ while lowest < highest && q.[lowest + 1].Count = 0 do
+ lowest <- lowest + 1
+ if highest = lowest
+ then
+ highest <- -1
+ lowest <- size
+
+ value, next
+
+ member this.Max =
+ highest |> byte
+
+ member this.Min =
+ lowest + 1 |> byte
+
+ member this.Add (value: byte) (p: Point) =
+ let vi = int value
+
+ if vi > highest
+ then
+ highest <- vi
+ if vi <= lowest
+ then
+ lowest <- vi - 1
+
+ q.[vi].Add(p) |> ignore
+
+ 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
+ highest <- highest - 1
+ while highest > lowest && q.[highest].Count = 0 do
+ highest <- highest - 1
+ 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
+ highest <- -1
+ lowest <- size
+
+ member this.IsEmpty =
+ highest = -1
+
+ member this.Clear () =
+ while highest > lowest do
+ q.[highest].Clear()
+ highest <- highest - 1
+ highest <- -1
+ lowest <- size
+
+type private AreaState =
+ | Removed = 1
+ | Unprocessed = 2
+ | Validated = 3
+
+type private AreaOperation =
+ | Opening = 1
+ | Closing = 2
+
+[<AllowNullLiteral>]
+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 w = img.Width
+ let h = img.Height
+ let imgData = img.Data
+ let se = [| -1, 0; 0, -1; 1, 0; 0, 1 |]
+
+ 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
+ for m in areas do
+ for e in m.Elements do
+ pixels.[e.Y, e.X] <- m
+
+ let queue = PriorityQueue()
+
+ 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
+ queue.Add (imgData.[ni, nj, 0]) p'
+
+ // Reverse order is quicker.
+ for i in areas.Count - 1 .. -1 .. 0 do
+ let m = areas.[i]
+ if m.Elements.Count <= area && m.State <> AreaState.Removed
+ then
+ queue.Clear()
+ addEdgeToQueue m.Elements
+
+ let mutable intensity = if op = AreaOperation.Opening then queue.Max else queue.Min
+ let nextElements = Points()
+
+ let mutable stop = false
+ while not stop do
+ 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
+ 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
+ m.Elements.UnionWith(nextElements)
+ for e in nextElements do
+ pixels.[e.Y, e.X] <- m
+
+ if m.Elements.Count = area
+ then
+ m.State <- AreaState.Validated
+ m.Intensity <- Some (intensity')
+ stop <- true
+ else
+ intensity <- intensity'
+ nextElements.Clear()
+ nextElements.Add(p) |> ignore
+
+ else
+ match pixels.[p.Y, p.X] with
+ | null -> ()
+ | m' ->
+ 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
+ queue.Remove imgData.[e.Y, e.X, 0] e
+ addEdgeToQueue m'.Elements
+ m.Elements.UnionWith(m'.Elements)
+ let intensityMax = if op = AreaOperation.Opening then queue.Max else queue.Min
+ if intensityMax <> intensity
+ then
+ intensity <- intensityMax
+ nextElements.Clear()
+ merged <- true
+
+ if not merged
+ then
+ m.State <- AreaState.Validated
+ m.Intensity <- Some (intensity)
+ stop <- true
+
+ 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
+ m.State <- AreaState.Validated
+ m.Intensity <- Some (intensity)
+ stop <- true
+ 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
+ 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
+ match m.Intensity with
+ | Some i ->
+ for p in m.Elements do
+ imgData.[p.Y, p.X, 0] <- i
+ | _ -> ()
+ ()
+
+let areaOpen (img: Image<Gray, byte>) (area: int) =
+ areaOperation img area AreaOperation.Opening
+
+let areaClose (img: Image<Gray, byte>) (area: int) =
+ areaOperation img area AreaOperation.Closing
+
+[<AllowNullLiteral>]
+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
+
+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 ownership: Island[,] = Array2D.create h w null
+
+ // Initialize islands with their shore.
+ let islands = List<Island>()
+ let extremum = img |> if op = AreaOperation.Opening then findMaxima else findMinima
+ for e in extremum do
+ let island =
+ let p = e.First()
+ Island(comparer, Level = earth.[p.Y, p.X, 0], Surface = e.Count)
+ islands.Add(island)
+ let shorePoints = Points()
+ for p in e do
+ ownership.[p.Y, p.X] <- island
+ for i, j in se do
+ 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
+ shorePoints.Add(neighbor) |> ignore
+ island.Shore.Add earth.[ni, nj, 0] neighbor
+
+ for area, obj in areas do
+ for island in islands do
+ let mutable stop = island.Shore.IsEmpty
+
+ // 'true' if 'p' is owned or adjacent to 'island'.
+ 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) ||
+ (p.X > 0 && ownership.[p.Y, p.X - 1] = island) ||
+ (p.X < w - 1 && ownership.[p.Y, p.X + 1] = 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
+ island.Shore.RemoveNext ()
+ else
+ if not <| Object.ReferenceEquals(other, null)
+ then // We touching another island.
+ if island.Surface + other.Surface >= area
+ then
+ stop <- true
+ else // We can merge 'other' into 'surface'.
+ island.Surface <- island.Surface + other.Surface
+ island.Level <- if comparer.Compare(island.Level, other.Level) > 0 then island.Level else other.Level
+ for l, p in other.Shore do
+ let mutable currentY = p.Y + 1
+ while currentY < h && ownership.[currentY, p.X] = other do
+ ownership.[currentY, p.X] <- island
+ currentY <- currentY + 1
+ island.Shore.Add l p
+ other.Shore.Clear()
+
+ 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
+ island.Surface <- Int32.MaxValue
+ stop <- true
+ else
+ let neighbor = Point(nj, ni)
+ if not <| ownedOrAdjacent neighbor
+ then
+ island.Shore.Add earth.[ni, nj, 0] neighbor
+ if not stop
+ then
+ ownership.[next.Y, next.X] <- island
+ island.Level <- level
+ island.Surface <- island.Surface + 1
+
+ let mutable diff = 0.f
+
+ for i in 0 .. h - 1 do
+ for j in 0 .. w - 1 do
+ match ownership.[i, j] with
+ | null -> ()
+ | island ->
+ let l = island.Level
+ diff <- diff + l - earth.[i, j, 0]
+ earth.[i, j, 0] <- l
+
+ match f with
+ | Some f' -> f' obj diff
+ | _ -> ()
+ ()
+
+let areaOpenF (img: Image<Gray, float32>) (area: int) =
+ areaOperationF img [ area, () ] None AreaOperation.Opening
+
+let areaCloseF (img: Image<Gray, float32>) (area: int) =
+ areaOperationF img [ area, () ] None AreaOperation.Closing
+
+let areaOpenFWithFun (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: 'a -> float32 -> unit) =
+ areaOperationF img areas (Some f) AreaOperation.Opening
+
+let areaCloseFWithFun (img: Image<Gray, float32>) (areas: (int * 'a) list) (f: 'a -> float32 -> unit) =
+ areaOperationF img areas (Some f) AreaOperation.Closing
+
+// A simpler algorithm than 'areaOpen' but slower.
+let areaOpen2 (img: Image<Gray, byte>) (area: int) =
+ let w = img.Width
+ let h = img.Height
+ let imgData = img.Data
+ let se = [| -1, 0; 0, -1; 1, 0; 0, 1 |]
+
+ let histogram = Array.zeroCreate 256
+ for i in 0 .. h - 1 do
+ for j in 0 .. w - 1 do
+ let v = imgData.[i, j, 0] |> int
+ histogram.[v] <- histogram.[v] + 1
+
+ let flooded : bool[,] = Array2D.zeroCreate h w
+
+ let pointsChecked = HashSet<Point>()
+ let pointsToCheck = Stack<Point>()
+
+ for level in 255 .. -1 .. 0 do
+ let mutable n = histogram.[level]
+ if n > 0
+ then
+ for i in 0 .. h - 1 do
+ for j in 0 .. w - 1 do
+ if not flooded.[i, j] && imgData.[i, j, 0] = byte level
+ then
+ let mutable maxNeighborValue = 0uy
+ pointsChecked.Clear()
+ pointsToCheck.Clear()
+ pointsToCheck.Push(Point(j, i))
+
+ while pointsToCheck.Count > 0 do
+ let next = pointsToCheck.Pop()
+ pointsChecked.Add(next) |> ignore
+ flooded.[next.Y, next.X] <- true
+
+ 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
+ let v = imgData.[p.Y, p.X, 0]
+ if v = byte level
+ then
+ if not (pointsChecked.Contains(p))
+ then
+ pointsToCheck.Push(p)
+ elif v > maxNeighborValue
+ then
+ maxNeighborValue <- v
+
+ if int maxNeighborValue < level && pointsChecked.Count <= area
+ then
+ for p in pointsChecked do
+ imgData.[p.Y, p.X, 0] <- maxNeighborValue
+
+// Zhang and Suen algorithm.
+// Modify 'mat' in place.
+let thin (mat: Matrix<byte>) =
+ let w = mat.Width
+ let h = mat.Height
+ let mutable data1 = mat.Data
+ let mutable data2 = Array2D.copy data1
+
+ let mutable pixelChanged = true
+ let mutable oddIteration = true
+
+ while pixelChanged do
+ pixelChanged <- false
+ for i in 0..h-1 do
+ for j in 0..w-1 do
+ 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]
+ let p5 = if i = h-1 || j = w-1 then 0uy else data1.[i+1, j+1]
+ let p6 = if i = h-1 then 0uy else data1.[i+1, j]
+ let p7 = if i = h-1 || j = 0 then 0uy else data1.[i+1, j-1]
+ let p8 = if j = 0 then 0uy else data1.[i, j-1]
+ let p9 = if i = 0 || j = 0 then 0uy else data1.[i-1, j-1]
+
+ let sumNeighbors = p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9
+ if sumNeighbors >= 2uy && sumNeighbors <= 6uy &&
+ (if p2 = 0uy && p3 = 1uy then 1 else 0) +
+ (if p3 = 0uy && p4 = 1uy then 1 else 0) +
+ (if p4 = 0uy && p5 = 1uy then 1 else 0) +
+ (if p5 = 0uy && p6 = 1uy then 1 else 0) +
+ (if p6 = 0uy && p7 = 1uy then 1 else 0) +
+ (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
+ then
+ data2.[i, j] <- 0uy
+ pixelChanged <- true
+ else
+ data2.[i, j] <- 0uy
+
+ oddIteration <- not oddIteration
+ let tmp = data1
+ data1 <- data2
+ data2 <- tmp
+
+// Remove all 8-connected pixels with an area equal or greater than 'areaSize'.
+// Modify 'mat' in place.
+let removeArea (mat: Matrix<byte>) (areaSize: int) =
+ let neighbors = [|
+ (-1, 0) // p2
+ (-1, 1) // p3
+ ( 0, 1) // p4
+ ( 1, 1) // p5
+ ( 1, 0) // p6
+ ( 1, -1) // p7
+ ( 0, -1) // p8
+ (-1, -1) |] // p9
+
+ use mat' = new Matrix<byte>(mat.Size)
+ let w = mat'.Width
+ let h = mat'.Height
+ mat.CopyTo(mat')
+
+ let data = mat.Data
+ let data' = mat'.Data
+
+ for i in 0..h-1 do
+ for j in 0..w-1 do
+ if data'.[i, j] = 1uy
+ then
+ let neighborhood = List<Point>()
+ let neighborsToCheck = Stack<Point>()
+ neighborsToCheck.Push(Point(j, i))
+ data'.[i, j] <- 0uy
+
+ while neighborsToCheck.Count > 0 do
+ let n = neighborsToCheck.Pop()
+ neighborhood.Add(n)
+ 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
+ neighborsToCheck.Push(Point(pj, pi))
+ data'.[pi, pj] <- 0uy
+ 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>) : List<Point> =
+ let w = img.Width
+ let h = img.Height
+
+ let pointChecked = Points()
+ let pointToCheck = Stack<Point>(startPoints);
+
+ let data = img.Data
+
+ while pointToCheck.Count > 0 do
+ let next = pointToCheck.Pop()
+ pointChecked.Add(next) |> ignore
+ for ny in -1 .. 1 do
+ for nx in -1 .. 1 do
+ 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
+ pointToCheck.Push(p)
+
+ List<Point>(pointChecked)
+
+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) =
+ 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: Types.Ellipse) (color: 'TColor) (alpha: float) =
+ if alpha >= 1.0
+ then
+ img.Draw(Ellipse(PointF(float32 e.Cx, float32 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 gapX = windowPosX - (float32 (int windowPosX))
+
+ let windowPosY = e.Cy - e.A - 5.f
+ let gapY = windowPosY - (float32 (int windowPosY))
+
+ 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
+ use i = new Image<'TColor, 'TDepth>(img.ROI.Size)
+ i.Draw(Ellipse(PointF(float32 <| (e.A + 5.f + gapX) , float32 <| (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: Types.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: Types.Cell) =
+ if drawCellContent
+ then
+ let colorB = rngCell.Next(20, 70)
+ let colorG = rngCell.Next(20, 70)
+ let colorR = rngCell.Next(20, 70)
+
+ for y in 0 .. c.elements.Height - 1 do
+ for x in 0 .. c.elements.Width - 1 do
+ 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
+ let r = img.Data.[y + dy, x + dx, 2] |> int
+ img.Data.[y + dy, x + dx, 0] <- if b + colorB > 255 then 255uy else byte (b + colorB)
+ img.Data.[y + dy, x + dx, 1] <- if g + colorG > 255 then 255uy else byte (g + colorG)
+ img.Data.[y + dy, x + dx, 2] <- if r + colorR > 255 then 255uy else byte (r + colorR)
+
+ let crossColor, crossColor2 =
+ match c.cellClass with
+ | Types.HealthyRBC -> Bgr(255., 0., 0.), Bgr(255., 255., 255.)
+ | Types.InfectedRBC -> Bgr(0., 0., 255.), Bgr(120., 120., 255.)
+ | Types.Peculiar -> Bgr(0., 0., 0.), Bgr(80., 80., 80.)
+
+ drawLine img crossColor2 (c.center.X - 3) c.center.Y (c.center.X + 3) c.center.Y 2
+ drawLine img crossColor2 c.center.X (c.center.Y - 3) c.center.X (c.center.Y + 3) 2
+
+ 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: Types.Cell list) =
+ List.iter (fun c -> drawCell img drawCellContent c) cells
\ No newline at end of file
--- /dev/null
+module ParasitemiaCore.KMeans
+
+open System.Collections.Generic
+open System.Drawing
+
+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 =
+ let nbIteration = 4
+ let w = img.Width
+ let h = img.Height
+
+ 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 minf = float32 (!min).[0]
+ let maxf = float32 (!max).[0]
+
+ let mutable mean_bg = maxf - (maxf - minf) / 4.f
+ let mutable mean_fg = minf + (maxf - minf) / 4.f
+ use mutable d_bg : Image<Gray, float32> = null
+ let mutable d_fg : Image<Gray, float32> = null
+ let fg = new Image<Gray, byte>(img.Size)
+
+ let imgData = img.Data
+ let fgData = fg.Data
+
+ for i in 1 .. nbIteration do
+ match d_bg with
+ | null -> ()
+ | _ ->
+ d_bg.Dispose()
+ d_fg.Dispose()
+
+ // EmGu doesn't import the in-place version of 'AbsDiff' so we have to create two images for each iteration.
+ d_bg <- img.AbsDiff(Gray(float mean_bg))
+ d_fg <- img.AbsDiff(Gray(float mean_fg))
+
+ CvInvoke.Compare(d_fg, d_bg, fg, CvEnum.CmpType.LessThan)
+
+ let mutable bg_total = 0.f
+ let mutable bg_nb = 0
+
+ let mutable fg_total = 0.f
+ let mutable fg_nb = 0
+
+ for i in 0 .. h - 1 do
+ for j in 0 .. w - 1 do
+ if fgData.[i, j, 0] > 0uy
+ then
+ fg_total <- fg_total + imgData.[i, j, 0]
+ fg_nb <- fg_nb + 1
+ else
+ bg_total <- bg_total + imgData.[i, j, 0]
+ bg_nb <- bg_nb + 1
+
+ mean_bg <- bg_total / float32 bg_nb
+ mean_fg <- fg_total / float32 fg_nb
+
+ { fg = fg; mean_bg = mean_bg; mean_fg = mean_fg; d_fg = d_fg }
\ No newline at end of file
--- /dev/null
+module ParasitemiaCore.KMedians
+
+open System.Collections.Generic
+open System.Drawing
+
+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 =
+ let nbIteration = 4
+ let w = img.Width
+ let h = img.Height
+
+ 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 mutable median_bg = (!max).[0] - ((!max).[0] - (!min).[0]) / 4.0
+ let mutable median_fg = (!min).[0] + ((!max).[0] - (!min).[0]) / 4.0
+ use mutable d_bg = new Image<Gray, float32>(img.Size)
+ let mutable d_fg = new Image<Gray, float32>(img.Size)
+ let mutable fg = new Image<Gray, byte>(img.Size)
+
+ for i in 1 .. nbIteration do
+ d_bg <- img.AbsDiff(Gray(median_bg))
+ d_fg <- img.AbsDiff(Gray(median_fg))
+
+ CvInvoke.Compare(d_fg, d_bg, fg, CvEnum.CmpType.LessThan)
+
+ let bg_values = List<float>()
+ let fg_values = List<float>()
+
+ for i in 0 .. h - 1 do
+ for j in 0 .. 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])
+
+ median_bg <- MathNet.Numerics.Statistics.Statistics.Median(bg_values)
+ median_fg <- MathNet.Numerics.Statistics.Statistics.Median(fg_values)
+
+ { fg = fg; median_bg = median_bg; median_fg = median_fg; d_fg = d_fg }
+
+
+
+
--- /dev/null
+module ParasitemiaCore.KdTree
+
+open System
+
+type I2DCoords =
+ abstract X : float32
+ abstract Y : float32
+
+// Compare 'e1' and 'e2' by X.
+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
+ | v -> v
+
+// Compare 'e1' and 'e2' by Y.
+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
+ member this.Contains px py : bool =
+ px >= this.minX && px <= this.maxX &&
+ py >= this.minY && py <= this.maxY
+
+ member this.IsSub otherRegion : bool =
+ this.minX >= otherRegion.minX && this.maxX <= otherRegion.maxX &&
+ this.minY >= otherRegion.minY && this.maxY <= otherRegion.maxY
+
+ member this.Intersects otherRegion : bool =
+ this.minX < otherRegion.maxX && this.maxX >= otherRegion.minX &&
+ this.minY < otherRegion.maxY && this.maxY >= otherRegion.minY
+
+type Tree<'a when 'a :> I2DCoords> =
+ | Node of float32 * Tree<'a> * Tree<'a>
+ | Leaf of '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
+ Leaf pXSorted.[0]
+ else
+ if depth % 2 = 1 // 'depth' is odd -> vertical splitting else horizontal splitting.
+ then
+ 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.
+ 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.
+ 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>) : 'a list =
+ match tree with
+ | Leaf v -> [v]
+ | Node (_, part1, part2) -> (valuesFrom part1) @ (valuesFrom part2)
+
+ 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
+ valuesFrom treeRegion
+ elif region.Intersects searchRegion
+ then
+ searchWithRegion treeRegion region (depth + 1)
+ else
+ []
+
+ if depth % 2 = 1 // Vertical splitting.
+ then
+ let leftRegion = { currentRegion with maxX = splitValue }
+ let rightRegion = { currentRegion with minX = splitValue }
+ (valuesInRegion leftRegion part1) @ (valuesInRegion rightRegion part2)
+ else // Horizontal splitting.
+ let downRegion = { currentRegion with maxY = splitValue }
+ let upRegion = { currentRegion with minY = splitValue }
+ (valuesInRegion downRegion part1) @ (valuesInRegion upRegion part2)
+
+ searchWithRegion this { minX = Single.MinValue; maxX = Single.MaxValue; minY = Single.MinValue; maxY = Single.MaxValue } 1
+
+///// Tests. TODO: to put in a unit test.
+
+type Point (x: float32, y: float32) =
+ interface I2DCoords with
+ member this.X = x
+ member this.Y = y
+
+ override this.ToString () =
+ sprintf "(%.1f, %.1f)" x 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 tree = Tree.BuildTree pts
+ Utils.dprintfn "Tree: %A" tree
+
+ let s1 = tree.Search { minX = 0.0f; maxX = 5.0f; minY = 0.0f; maxY = 5.0f } // All points.
+ Utils.dprintfn "s1: %A" s1
+
+ let s2 = tree.Search { minX = 2.8f; maxX = 4.5f; minY = 3.0f; maxY = 4.5f }
+ Utils.dprintfn "s2: %A" s2
+
+ let s3 = tree.Search { minX = 2.0f; maxX = 2.0f; minY = 2.0f; maxY = 2.0f }
+ 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 tree = Tree.BuildTree pts
+ Utils.dprintfn "Tree: %A" tree
+
+ let s1 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 1.0f; maxY = 1.0f }
+ Utils.dprintfn "s1: %A" s1
+
+ let s2 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 2.0f; maxY = 2.0f }
+ Utils.dprintfn "s2: %A" s2
+
+ // This case result is wrong: FIXME
+ let s3 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 3.0f; maxY = 3.0f }
+ Utils.dprintfn "s3: %A" s3
+
+ let s4 = tree.Search { minX = 0.0f; maxX = 2.0f; minY = 0.0f; maxY = 4.0f }
+ Utils.dprintfn "s4: %A" s4
+
--- /dev/null
+module ParasitemiaCore.Analysis
+
+open System
+open System.Linq
+open System.Drawing
+
+open FSharp.Collections.ParallelSeq
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Logger
+
+open Utils
+open ImgTools
+open Config
+open Types
+
+let doAnalysis (img: Image<Bgr, byte>) (name: string) (config: Config) (reportProgress: (int -> unit) option) : Cell list =
+ // To report the progress of this function from 0 to 100.
+ let inline report (percent: int) =
+ match reportProgress with
+ | Some f -> f percent
+ | _ -> ()
+
+ 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) : 'a = Log.LogWithTime((buildLogWithName text), Severity.USER, f)
+
+ logWithName "Starting analysis ..."
+
+ use green = img.Item(1)
+ let greenFloat = green.Convert<Gray, float32>()
+ let filteredGreen = gaussianFilter greenFloat config.LPFStandardDeviation
+
+ logWithName (sprintf "Nominal erytrocyte diameter: %A" config.RBCRadiusByResolution)
+
+ let initialAreaOpening = int <| config.RBCRadiusByResolution.Area * config.Parameters.ratioAreaPaleCenter * 1.2f // We do an area opening a little larger to avoid to do a second one in the case the radius found is near the initial one.
+ logTimeWithName "Area opening number one" (fun () -> ImgTools.areaOpenF filteredGreen initialAreaOpening)
+
+ report 10
+
+ let range =
+ let delta = config.Parameters.granulometryRange * config.RBCRadiusByResolution.Pixel
+ int <| config.RBCRadiusByResolution.Pixel - delta, int <| config.RBCRadiusByResolution.Pixel + delta
+ //let r1 = log "Granulometry (morpho)" (fun() -> Granulometry.findRadiusByClosing (filteredGreen.Convert<Gray, byte>()) range 1.0 |> float32)
+ config.SetRBCRadius <| logTimeWithName "Granulometry (area)" (fun() -> Granulometry.findRadiusByAreaClosing filteredGreen range |> float32)
+
+ logWithName (sprintf "Found erytrocyte diameter: %A" config.RBCRadius)
+
+ report 20
+
+ let secondAreaOpening = int <| config.RBCRadius.Area * config.Parameters.ratioAreaPaleCenter
+ if secondAreaOpening > initialAreaOpening
+ then
+ logTimeWithName "Area opening number two" (fun () -> ImgTools.areaOpenF filteredGreen secondAreaOpening)
+
+ let parasites, filteredGreenWhitoutStain = ParasitesMarker.find filteredGreen config
+ //let parasites, filteredGreenWhitoutInfection, filteredGreenWhitoutStain = ParasitesMarker.findMa greenFloat filteredGreenFloat config
+
+ let edges, xGradient, yGradient = logTimeWithName "Finding edges" (fun () ->
+ let edges, xGradient, yGradient = ImgTools.findEdges filteredGreenWhitoutStain
+ removeArea edges (config.RBCRadius.Pixel ** 2.f / 50.f |> int)
+ edges, xGradient, yGradient)
+
+ let matchingEllipses = logTimeWithName "Finding ellipses" (fun () -> Ellipse.find edges xGradient yGradient config)
+
+ report 60
+
+ let prunedEllipses = logTimeWithName "Ellipses pruning" (fun () -> matchingEllipses.PrunedEllipses)
+
+ report 80
+
+ let cells = logTimeWithName "Classifier" (fun () -> Classifier.findCells prunedEllipses parasites filteredGreenWhitoutStain config)
+
+ report 100
+
+ logWithName "Analysis finished"
+
+ // Output pictures if debug flag is set.
+ match config.Debug with
+ | DebugOn output ->
+ let dirPath = System.IO.Path.Combine(output, name)
+ System.IO.Directory.CreateDirectory dirPath |> ignore
+
+ let buildFileName postfix = System.IO.Path.Combine(dirPath, name + postfix)
+
+ saveMat (edges * 255.0) (buildFileName " - edges.png")
+
+ saveImg parasites.darkStain (buildFileName " - parasites - dark stain.png")
+ saveImg parasites.stain (buildFileName " - parasites - stain.png")
+ saveImg parasites.infection (buildFileName " - parasites - infection.png")
+
+ let imgAllEllipses = img.Copy()
+ drawEllipses imgAllEllipses matchingEllipses.Ellipses (Bgr(255.0, 255.0, 255.0)) 0.04
+ saveImg imgAllEllipses (buildFileName " - ellipses - all.png")
+
+ let imgEllipses = filteredGreenWhitoutStain.Convert<Bgr, byte>()
+ drawEllipses imgEllipses prunedEllipses (Bgr(0.0, 240.0, 240.0)) 1.0
+ saveImg imgEllipses (buildFileName " - ellipses.png")
+
+ let imgCells = img.Copy()
+ drawCells imgCells false cells
+ saveImg imgCells (buildFileName " - cells.png")
+
+ let imgCells' = img.Copy()
+ drawCells imgCells' true cells
+ saveImg imgCells' (buildFileName " - cells - full.png")
+
+ let filteredGreenMaxima = gaussianFilter greenFloat config.LPFStandardDeviation
+ for m in ImgTools.findMaxima filteredGreenMaxima do
+ ImgTools.drawPoints filteredGreenMaxima m 255.f
+ saveImg filteredGreenMaxima (buildFileName " - filtered - maxima.png")
+
+ saveImg filteredGreen (buildFileName " - filtered.png")
+ saveImg filteredGreenWhitoutStain (buildFileName " - filtered closed stain.png")
+ //saveImg filteredGreenWhitoutInfection (buildFileName " - filtered closed infection.png")
+
+ saveImg green (buildFileName " - green.png")
+
+ use blue = img.Item(0)
+ saveImg blue (buildFileName " - blue.png")
+
+ use red = img.Item(2)
+ saveImg red (buildFileName " - red.png")
+ | _ -> ()
+
+ cells
+
+// ID * cell list.
+let doMultipleAnalysis (imgs: (string * Config * Image<Bgr, byte>) list) (reportProgress: (int -> unit) option) : (string * Cell list) list =
+ let inline report (percent: int) =
+ match reportProgress with
+ | Some f -> f percent
+ | _ -> ()
+
+ let progressPerAnalysis = System.Collections.Concurrent.ConcurrentDictionary<string, int>()
+ let nbImgs = List.length imgs
+
+ let reportProgressImg (id: string) (progress: int) =
+ progressPerAnalysis.AddOrUpdate(id, progress, (fun _ _ -> progress)) |> ignore
+ report (progressPerAnalysis.Values.Sum() / nbImgs)
+
+ let n = Environment.ProcessorCount
+
+ imgs
+ |> PSeq.map (fun (id, config, img) -> id, doAnalysis img id config (Some (fun p -> reportProgressImg id p)))
+ |> PSeq.withDegreeOfParallelism n
+ |> PSeq.toList
--- /dev/null
+module ParasitemiaCore.MatchingEllipses
+
+open System
+open System.Linq
+open System.Collections
+open System.Collections.Generic
+
+open Types
+open Utils
+
+type private EllipseScoreFlaggedKd (matchingScore: float32, e: Ellipse) =
+ let mutable matchingScore = matchingScore
+
+ member this.Ellipse = e
+
+ member this.MatchingScore = matchingScore
+
+ member this.AddMatchingScore (score: float32) =
+ matchingScore <- matchingScore + score
+
+ member val Processed = false with get, set
+ member val Removed = false with get, set
+
+ interface KdTree.I2DCoords with
+ member this.X = this.Ellipse.Cx
+ member this.Y = this.Ellipse.Cy
+
+type MatchingEllipses (radius: float32) =
+ let ellipses = List<EllipseScoreFlaggedKd>()
+
+ // All ellipses with a score below this are removed.
+ let matchingScoreThreshold = 0.8f
+
+ 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
+ []
+ else
+ // 1) Create a kd-tree from the ellipses list.
+ let tree = KdTree.Tree.BuildTree (List.ofSeq ellipses)
+
+ // 2) Compute the matching score of each ellipses.
+ let windowSize = radius / 2.f
+ 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 }
+ for other in tree.Search window do
+ if not other.Processed
+ then
+ let areaOther = other.Ellipse.Area
+ match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
+ | Some (overlapArea, _, _) ->
+ let matchingScore = (2.f * overlapArea / (areaE + areaOther)) ** 30.f
+ if matchingScore <= 1.f // For approximation error.
+ then
+ other.AddMatchingScore(matchingScore)
+ e.AddMatchingScore(matchingScore)
+ | _ -> ()
+
+ // 3) Remove ellipses whose center is near the center of another ellipse with a better score.
+ for e in ellipses do
+ 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 }
+ for other in tree.Search window do
+ if not other.Removed && e.MatchingScore > other.MatchingScore
+ then
+ // Case where ellipses are too close.
+ if distanceTwoPoints (PointD(e.Ellipse.Cx, e.Ellipse.Cy)) (PointD(other.Ellipse.Cx, other.Ellipse.Cy)) < 0.3f * e.Ellipse.B
+ then
+ other.Removed <- true
+ else
+ // Case where ellipses are overlapped.
+ match EEOver.EEOverlapArea e.Ellipse other.Ellipse with
+ | Some (overlapArea, _, _) when e.Ellipse.Area < 1.1f * overlapArea || other.Ellipse.Area < 1.1f * overlapArea ->
+ other.Removed <- true
+ | _ ->
+ ()
+
+ ellipses
+ |> List.ofSeq
+ |> List.filter (fun e -> not e.Removed)
+ |> List.sortWith (fun e1 e2 -> e2.MatchingScore.CompareTo(e1.MatchingScore))
+ |> List.map (fun e -> e.Ellipse)
+
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>0f8a85f4-9328-40c3-b8ff-44fb39ceb01f</ProjectGuid>
+ <OutputType>Library</OutputType>
+ <RootNamespace>ParasitemiaCore</RootNamespace>
+ <AssemblyName>ParasitemiaCore</AssemblyName>
+ <TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
+ <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
+ <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
+ <Name>ParasitemiaCore</Name>
+ <TargetFrameworkProfile />
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <DocumentationFile>bin\Debug\ParasitemiaCore.XML</DocumentationFile>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <Tailcalls>true</Tailcalls>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <DocumentationFile>bin\Release\ParasitemiaCore.XML</DocumentationFile>
+ </PropertyGroup>
+ <PropertyGroup>
+ <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+ </PropertyGroup>
+ <Choose>
+ <When Condition="'$(VisualStudioVersion)' == '11.0'">
+ <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
+ <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
+ </PropertyGroup>
+ </When>
+ <Otherwise>
+ <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
+ <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
+ </PropertyGroup>
+ </Otherwise>
+ </Choose>
+ <Import Project="$(FSharpTargetsPath)" />
+ <ItemGroup>
+ <Compile Include="AssemblyInfo.fs" />
+ <Compile Include="Heap.fs" />
+ <Compile Include="UnitsOfMeasure.fs" />
+ <Compile Include="Const.fs" />
+ <Compile Include="Types.fs" />
+ <Compile Include="EEOver.fs" />
+ <Compile Include="Utils.fs" />
+ <Compile Include="ImgTools.fs" />
+ <Compile Include="Granulometry.fs" />
+ <Compile Include="Config.fs" />
+ <Compile Include="KMedians.fs" />
+ <Compile Include="KMeans.fs" />
+ <Compile Include="ParasitesMarker.fs" />
+ <Compile Include="KdTree.fs" />
+ <Compile Include="MatchingEllipses.fs" />
+ <Compile Include="Ellipse.fs" />
+ <Compile Include="Classifier.fs" />
+ <Compile Include="MainAnalysis.fs" />
+ <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>
+ <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)">
+ <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>
+ </Reference>
+ <Reference Include="MathNet.Numerics.FSharp">
+ <HintPath>..\packages\MathNet.Numerics.FSharp.3.10.0\lib\net40\MathNet.Numerics.FSharp.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="mscorlib" />
+ <Reference Include="System" />
+ <Reference Include="System.Core" />
+ <Reference Include="System.Drawing" />
+ <Reference Include="System.Numerics" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="..\Logger\Logger.fsproj">
+ <Name>Logger</Name>
+ <Project>{a4f183ae-562a-4bad-88e6-658b4ce15dc3}</Project>
+ <Private>True</Private>
+ </ProjectReference>
+ </ItemGroup>
+ <!-- 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.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
\ No newline at end of file
--- /dev/null
+module ParasitemiaCore.ParasitesMarker
+
+open System.Drawing
+open System.Linq
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Logger
+
+open Utils
+
+type Result = {
+ darkStain: Image<Gray, byte>
+ infection: Image<Gray, byte>
+ stain: Image<Gray, byte> }
+
+// Create three binary markers :
+// * 'Dark stain' corresponds to the colored pixel, it's independent of the size of the areas.
+// * 'Stain' corresponds to the stain around the parasites.
+// * 'Infection' corresponds to the parasite. It shouldn't contain thrombocytes.
+let findMa (green: Image<Gray, float32>) (filteredGreen: Image<Gray, float32>) (config: Config.Config) : Result * Image<Gray, byte> * Image<Gray, byte> =
+ // We use the filtered image to find the dark stain.
+ let kmediansResults = Log.LogWithTime("Finding fg/bg (k-medians)", Severity.USER, (fun () -> KMedians.kmedians filteredGreen))
+ let { KMedians.fg = fg; KMedians.median_bg = median_bg; KMedians.median_fg = median_fg; KMedians.d_fg = d_fg } = kmediansResults
+ let darkStain = d_fg.Cmp(median_bg * float config.Parameters.darkStainLevel, CvEnum.CmpType.GreaterThan)
+ darkStain._And(filteredGreen.Cmp(median_fg, CvEnum.CmpType.LessThan))
+ darkStain._And(fg)
+
+ let fgFloat = (fg / 255.0).Convert<Gray, float32>()
+ use greenWithoutBg = ImgTools.gaussianFilter green 1.0
+ greenWithoutBg.SetValue(Gray(0.0), fg.Not())
+
+ let findSmears (sigma: float) (level: float) : Image<Gray, byte> =
+ use greenWithoutBgSmoothed = ImgTools.gaussianFilter greenWithoutBg sigma
+ use fgSmoothed = ImgTools.gaussianFilter fgFloat sigma
+ let smears = (greenWithoutBg.Mul(fgSmoothed)).Cmp(greenWithoutBgSmoothed.Mul(level), CvEnum.CmpType.LessThan)
+ smears._And(fg)
+ smears
+
+ let tmp = filteredGreen.Convert<Gray, byte>()
+
+ { darkStain = darkStain;
+ stain = findSmears 10. 0.9
+ infection = findSmears 2.2 0.87 },
+ tmp,
+ tmp
+
+// Create three binary markers :
+// * 'Dark stain' corresponds to the colored pixel, it's independent of the size of the areas.
+// * 'Stain' corresponds to the stain around the parasites.
+// * 'Infection' corresponds to the parasite. It shouldn't contain thrombocytes.
+let find (filteredGreen: Image<Gray, float32>) (config: Config.Config) : Result * Image<Gray, float32> =
+ use filteredGreenWithoutInfection = filteredGreen.Copy()
+ ImgTools.areaCloseF filteredGreenWithoutInfection (int config.RBCRadius.InfectionArea)
+
+ let filteredGreenWithoutStain = filteredGreenWithoutInfection.Copy()
+ ImgTools.areaCloseF filteredGreenWithoutStain (int config.RBCRadius.StainArea)
+
+ let darkStain =
+ // We use the filtered image to find the dark stain.
+ let _, mean_fg, mean_bg =
+ let hist = ImgTools.histogramImg filteredGreenWithoutInfection 300
+ ImgTools.otsu hist
+ filteredGreenWithoutInfection.Cmp(-(float mean_bg) * config.Parameters.darkStainLevel + (float mean_fg), CvEnum.CmpType.LessThan)
+
+ 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)
+ diff._ThresholdBinary(Gray(0.0), Gray(255.))
+ diff.Convert<Gray, byte>()
+
+ let infectionMarker = marker filteredGreen filteredGreenWithoutInfection (1. / config.Parameters.infectionSensitivity)
+ let stainMarker = marker filteredGreenWithoutInfection filteredGreenWithoutStain (1. / config.Parameters.stainSensitivity)
+
+ // TODO: comprendre pourquoi des valeurs sont negatives!?!?
+ (*
+ let blackTopHat = filteredGreen.CopyBlank()
+ CvInvoke.Subtract(filteredGreenWithoutInfection, filteredGreen, blackTopHat)
+ ImgTools.saveImg (ImgTools.normalizeAndConvert blackTopHat) "BottomHat.png"
+ *)
+
+ { darkStain = darkStain
+ infection = infectionMarker
+ stain = stainMarker },
+ filteredGreenWithoutStain
+
+
--- /dev/null
+module ParasitemiaCore.Types
+
+open System
+open System.Drawing
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Const
+
+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.B = b
+ member this.Alpha = alpha
+ member this.Area = a * b * PI
+
+ // Does the ellipse contain the point (x, y)?.
+ 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 =
+ 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 =
+ 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) =
+ 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(this.Cx, this.Cy, this.A * factor, this.B * factor, alpha)
+
+ // Approximation of Ramanujan.
+ member this.Perimeter =
+ 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
+
+type CellClass = HealthyRBC | InfectedRBC | Peculiar
+
+type Cell = {
+ cellClass: CellClass
+ center: Point
+ infectedArea: int
+ stainArea: int
+ elements: Matrix<byte> }
+
+[<Struct>]
+type Line (a: float32, b: float32) =
+ member this.A = a
+ member this.B = b
+ member this.Valid = not (Single.IsInfinity this.A)
+
+[<Struct>]
+type PointD (x: float32, y: float32) =
+ member this.X = x
+ member this.Y = y
+
--- /dev/null
+module ParasitemiaCore.UnitsOfMeasure
+
+[<Measure>] type px
+[<Measure>] type μm
+[<Measure>] type inch
+[<Measure>] type ppi = px / inch
+
+let μmInchRatio = 25.4e3<μm/inch>
+
+let μmToInch(x: float<μm>) : float<inch> = x / μmInchRatio
+let inchToμm(x: float<inch>) : float<μm> = x * μmInchRatio
+
+
+
+
+
--- /dev/null
+module ParasitemiaCore.Utils
+
+open Types
+
+let inline roundInt v = v |> round |> int
+
+let inline dprintfn fmt =
+ Printf.ksprintf System.Diagnostics.Debug.WriteLine fmt
+
+let inline lineFromTwoPoints (p1: PointD) (p2: PointD) : Line =
+ let a = (p1.Y - p2.Y) / (p1.X - p2.X)
+ let b = -(p2.X * p1.Y - p1.X * p2.Y) / (p1.X - p2.X)
+ Line(a, b)
+
+let inline pointFromTwoLines (l1: Line) (l2: Line) : PointD =
+ let x = -(l1.B - l2.B) / (l1.A - l2.A)
+ let y = -(l2.A * l1.B - l1.A * l2.B) / (l1.A - l2.A)
+ PointD(x, y)
+
+let inline linePassThroughSegment (l: Line) (p1: PointD) (p2: PointD) : bool =
+ let p = pointFromTwoLines l (lineFromTwoPoints p1 p2)
+ sign (p.X - p1.X) <> sign (p.X - p2.X)
+
+let inline squaredDistanceTwoPoints (p1: PointD) (p2: PointD) =
+ (p1.X - p2.X) ** 2.f + (p1.Y - p2.Y) ** 2.f
+
+let inline distanceTwoPoints (p1: PointD) (p2: PointD) =
+ 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
--- /dev/null
+<?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" />
+</packages>
\ No newline at end of file
--- /dev/null
+module ParasitemiaUI.About
+
+open System
+open System.Windows
+open System.Windows.Media
+open System.Windows.Markup
+open System.Windows.Shapes
+open System.Windows.Controls
+open System.Diagnostics
+
+let showWindow (parent: Window) =
+ let window = Views.AboutWindow()
+ window.Root.Owner <- parent
+ window.Root.Left <- parent.Left + parent.ActualWidth / 2. - window.Root.Width / 2.
+ window.Root.Top <- parent.Top + parent.ActualHeight / 2. - window.Root.Height / 2.
+
+ let ctrl (name: string): 'a = window.Root.FindName(name) :?> 'a
+
+ let butClose: Button = ctrl "butClose"
+ let txtAbout: TextBlock = ctrl "txtAbout"
+
+ let version = System.Reflection.Assembly.GetEntryAssembly().GetName().Version
+ let txtVersion = sprintf "%d.%d.%d" version.Major version.Minor version.Revision
+ txtAbout.Inlines.FirstInline.ElementEnd.InsertTextInRun(txtVersion)
+
+#if DEBUG
+ txtAbout.Inlines.FirstInline.ElementEnd.InsertTextInRun(" - DEBUG")
+#endif
+
+ butClose.Click.AddHandler(fun obj args -> window.Root.Close())
+
+ window.Root.ShowDialog() |> ignore
+
--- /dev/null
+module ParasitemiaUI.Analysis
+
+open System
+open System.IO
+open System.Linq
+open System.Windows
+open System.Windows.Media
+open System.Windows.Markup
+open System.Windows.Shapes
+open System.Windows.Controls
+open System.Diagnostics
+open Microsoft.Win32 // For the common dialogs.
+
+open Emgu.CV.WPF
+
+open ParasitemiaCore.UnitsOfMeasure
+open ParasitemiaCore.Config
+
+open Types
+
+let showWindow (parent: Window) (state: State.State) : bool =
+ let window = Views.AnalysisWindow()
+ window.Root.Owner <- parent
+ window.Root.Left <- parent.Left + parent.ActualWidth / 2. - window.Root.Width / 2.
+ window.Root.Top <- parent.Top + parent.ActualHeight / 2. - window.Root.Height / 2.
+
+ let ctrl (name: string): 'a = window.Root.FindName(name) :?> 'a
+
+ let butClose: Button = ctrl "butClose"
+ let butStart: Button = ctrl "butStart"
+
+ let stackImagesSourceSelection: StackPanel = ctrl "stackImagesSourceSelection"
+ let progressBar: ProgressBar = ctrl "progress"
+ let textLog: TextBlock = ctrl "textLog"
+ let scrollLog: ScrollViewer = ctrl "scrollLog"
+
+ let logListener =
+ { new Logger.IListener with
+ member this.NewEntry severity mess =
+ window.Root.Dispatcher.Invoke(fun () ->
+ textLog.Inlines.Add(Documents.Run(mess))
+ textLog.Inlines.Add(Documents.LineBreak())
+ scrollLog.ScrollToBottom()) }
+
+ Logger.Log.AddListener(logListener)
+
+ let minPPI = 1.
+ let maxPPI = 10e6
+ let parseAndValidatePPI (input: string) : float option =
+ let res = ref 0.
+ if Double.TryParse(input, res) && !res >= minPPI && !res <= maxPPI
+ then Some !res
+ else None
+
+ let monitor = Object()
+ let mutable atLeastOneAnalysisPerformed = false
+ let mutable analysisPerformed = false
+ let mutable analysisCancelled = false
+
+ let updateSourceImages () =
+ stackImagesSourceSelection.Children.Clear()
+ let width = int stackImagesSourceSelection.ActualWidth
+ for srcImg in state.SourceImages do
+ let imageSourceSelection = Views.ImageSourceSelection(Tag = srcImg, Margin = Thickness(3.))
+
+ let updateResolution () =
+ match parseAndValidatePPI imageSourceSelection.txtResolution.Text with
+ | Some resolution -> srcImg.config.Parameters <- { srcImg.config.Parameters with resolution = resolution * 1.<ppi> }
+ | None -> ()
+
+ imageSourceSelection.txtImageNumber.Text <- srcImg.num.ToString()
+ let height = srcImg.img.Height * width / srcImg.img.Width
+ imageSourceSelection.imagePreview.Source <- BitmapSourceConvert.ToBitmapSource(srcImg.img.Resize(width, height, Emgu.CV.CvEnum.Inter.Cubic))
+ imageSourceSelection.chkSelection.IsChecked <- Nullable<bool>(srcImg.dateLastAnalysis.Ticks = 0L)
+ imageSourceSelection.lblDateLastAnalysis.Content <- if srcImg.dateLastAnalysis.Ticks = 0L then "<Never>" else srcImg.dateLastAnalysis.ToString()
+
+ imageSourceSelection.txtResolution.Text <- srcImg.config.Parameters.resolution.ToString()
+ imageSourceSelection.menuZoom50X.Click.AddHandler(fun obj args -> imageSourceSelection.txtResolution.Text <- "230000"; updateResolution ())
+ imageSourceSelection.menuZoom100X.Click.AddHandler(fun obj args -> imageSourceSelection.txtResolution.Text <- "460000"; updateResolution ())
+
+ imageSourceSelection.txtResolution.PreviewTextInput.AddHandler(fun obj args ->
+ let text = imageSourceSelection.txtResolution.Text + args.Text
+ args.Handled <- match parseAndValidatePPI text with Some _ -> false | None -> true)
+
+ imageSourceSelection.imagePreview.MouseLeftButtonDown.AddHandler(fun obj args ->
+ let checkbox = imageSourceSelection.chkSelection
+ checkbox.IsChecked <- Nullable<bool>(not (checkbox.IsChecked.HasValue && checkbox.IsChecked.Value)))
+
+ imageSourceSelection.txtResolution.LostFocus.AddHandler(fun obj args -> updateResolution ())
+
+ stackImagesSourceSelection.Children.Add(imageSourceSelection) |> ignore
+
+ butClose.Click.AddHandler(fun obj args -> window.Root.Close())
+
+ butStart.Click.AddHandler(fun obj args ->
+ let imagesToProcess = [
+ for imageSelection in stackImagesSourceSelection.Children |> Seq.cast<Views.ImageSourceSelection> do
+ let chk = imageSelection.chkSelection.IsChecked
+ if chk.HasValue && chk.Value
+ then
+ let srcImg = imageSelection.Tag :?> SourceImage
+ 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
+ analysisPerformed <- false
+ butStart.IsEnabled <- false
+ butClose.Content <- "Abort"
+ async {
+ let results =
+ ParasitemiaCore.Analysis.doMultipleAnalysis
+ imagesToProcess
+ (Some (fun progress -> window.Root.Dispatcher.Invoke(fun () -> progressBar.Value <- float progress)))
+
+ lock monitor (
+ fun() ->
+ if not analysisCancelled
+ then
+ for id, cells in results do
+ state.SetResult (int id) cells
+
+ window.Root.Dispatcher.Invoke(fun () ->
+ butStart.IsEnabled <- true
+ butClose.Content <- "Close"
+ updateSourceImages ())
+
+ Logger.Log.User("All analyses terminated successfully")
+ atLeastOneAnalysisPerformed <- true
+ analysisPerformed <- true)
+ } |> Async.Start)
+
+ window.Root.Loaded.AddHandler(fun obj args -> updateSourceImages ())
+
+ window.Root.ShowDialog() |> ignore
+
+ Logger.Log.RmListener(logListener)
+
+ lock monitor (fun () ->
+ if not analysisPerformed
+ then
+ analysisCancelled <- true
+ atLeastOneAnalysisPerformed)
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<configuration>
+ <startup>
+ <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.2" />
+ </startup>
+ <runtime>
+ <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
+ <dependentAssembly>
+ <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
+ <bindingRedirect oldVersion="0.0.0.0-4.4.0.0" newVersion="4.4.0.0" />
+ </dependentAssembly>
+ <dependentAssembly>
+ <assemblyIdentity name="Castle.Core" publicKeyToken="407dd0808d44fbdc" culture="neutral" />
+ <bindingRedirect oldVersion="0.0.0.0-1.1.0.0" newVersion="1.1.0.0" />
+ </dependentAssembly>
+ </assemblyBinding>
+ </runtime>
+</configuration>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.AssemblyInfo
+
+open System.Reflection
+open System.Runtime.CompilerServices
+open System.Runtime.InteropServices
+
+// General Information about an assembly is controlled through the following
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+[<assembly: AssemblyTitle("ParasitemiaUI")>]
+[<assembly: AssemblyDescription("")>]
+[<assembly: AssemblyConfiguration("")>]
+[<assembly: AssemblyCompany("HES-SO / CHUV / Grégory Burri")>]
+[<assembly: AssemblyProduct("ParasitemiaUI")>]
+[<assembly: AssemblyCopyright("Copyright © 2015-2016")>]
+[<assembly: AssemblyTrademark("")>]
+[<assembly: AssemblyCulture("")>]
+
+// Setting ComVisible to false makes the types in this assembly not visible
+// to COM components. If you need to access a type in this assembly from
+// COM, set the ComVisible attribute to true on that type.
+[<assembly: ComVisible(false)>]
+
+// The following GUID is for the ID of the typelib if this project is exposed to COM
+[<assembly: Guid("70838e65-f211-44fc-b28f-0ed1ca6e850f")>]
+
+// Version information for an assembly consists of the following four values:
+//
+// Major Version
+// Minor Version
+// Build Number
+// Revision
+//
+// 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.0")>]
+[<assembly: AssemblyFileVersion("1.0.0.0")>]
+
+do
+ ()
\ No newline at end of file
--- /dev/null
+module ParasitemiaUI.GUI
+
+open System
+open System.IO
+open System.Linq
+open System.Windows
+open System.Windows.Media
+open System.Windows.Markup
+open System.Windows.Shapes
+open System.Windows.Controls
+open System.Diagnostics
+open Microsoft.Win32 // For the common dialogs.
+
+open Emgu.CV.WPF
+
+open Logger
+
+open ParasitemiaCore.Config
+open ParasitemiaCore.Utils
+open Types
+
+let run (defaultConfig: Config) (fileToOpen: string option) =
+ let app = new Application()
+ let mainWindow = Views.MainWindow()
+ let ctrl (name: string): 'a = mainWindow.Root.FindName(name) :?> 'a
+
+ let colorRBCHealthy = Brushes.YellowGreen
+ let colorRBCInfected = Brushes.Red
+
+ let state = State.State()
+ let mutable currentScale = 1.
+ let mutable displayHealthy = false
+
+ let menuExit: MenuItem = ctrl "menuExit"
+ let menuSaveFile: MenuItem = ctrl "menuSave"
+ let menuLoadFile: MenuItem = ctrl "menuOpen"
+ let menuNewFile: MenuItem = ctrl "menuNew"
+ let menuAddSourceImage: MenuItem = ctrl "menuAddSourceImage"
+ let menuAnalysis: MenuItem = ctrl "menuAnalysis"
+ let menuStartAnalysis: MenuItem = ctrl "menuStartAnalysis"
+ let menuView: MenuItem = ctrl "menuView"
+ let menuHightlightRBC: MenuItem = ctrl "menuHightlightRBC"
+ let menuAbout: MenuItem = ctrl "menuAbout"
+
+ let txtPatient: TextBox = ctrl "txtPatient"
+ let txtGlobalParasitemia: TextBox = ctrl "txtGlobalParasitemia"
+
+ let stackPreviews: StackPanel = ctrl "stackPreviews"
+
+ let scrollViewCurrentImage: ScrollViewer = ctrl "scrollViewCurrentImage"
+ let borderCurrentImage: Border = ctrl "borderCurrentImage"
+ let canvasCurrentImage: Canvas = ctrl "canvasCurrentImage"
+ let txtImageInformation: TextBlock = ctrl "txtImageInformation"
+
+ let scrollRBC: ScrollViewer = ctrl "scrollRBC"
+ let stackRBC: StackPanel = ctrl "stackRBC"
+
+ // Initializations.
+ 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 rbcWidth = rbc.size.Width
+ let rbcHeight = rbc.size.Height
+ let x = rbc.center.X - rbcWidth / 2. |> roundInt
+ let y = rbc.center.Y - rbcHeight / 2. |> roundInt
+ let w = roundInt rbcWidth
+ let h = roundInt rbcHeight
+ img.GetSubRect(System.Drawing.Rectangle(System.Drawing.Point((if x < 0 then 0 else x), (if y < 0 then 0 else y)),
+ 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 (rbc: RBC) (frame: Views.RBCFrame) =
+ frame.Opacity <- if displayHealthy || rbc.setManually || rbc.infected then 1. else 0.
+ let color = if rbc.infected then colorRBCInfected else colorRBCHealthy
+ frame.manuallyAdded.Visibility <- if rbc.setManually then Visibility.Visible else Visibility.Hidden
+ frame.manuallyAdded.Fill <- color
+ frame.border.Stroke <- color
+
+ let RBCFrameFromExisting (rbc: RBC) (frame: Views.RBCFrame) : Views.RBCFrame =
+ frame.Visibility <- Visibility.Visible
+ frame.Height <- rbc.size.Height
+ frame.Width <- rbc.size.Width
+ frame.Tag <- rbc
+ setRBCFrameStyle rbc frame
+ frame.border.StrokeThickness <- 1.
+ frame.txtRBCNumber.Text <- rbc.num.ToString()
+ frame
+
+ let highlightRBCFrame (frame: Views.RBCFrame) (highlight: bool) =
+ let rbc = frame.Tag :?> RBC
+ 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) =
+ scrollViewCurrentImage.ScrollToHorizontalOffset(rbc.center.X * currentScale - scrollViewCurrentImage.ViewportWidth / 2. + borderCurrentImage.BorderThickness.Left)
+ scrollViewCurrentImage.ScrollToVerticalOffset(rbc.center.Y * currentScale - scrollViewCurrentImage.ViewportHeight / 2. + borderCurrentImage.BorderThickness.Top)
+
+ let parasitemiaText (nbTotal: int, nbInfected: int) : string =
+ if nbTotal = 0
+ then
+ ""
+ else
+ let percent = 100. * (float nbInfected) / (float nbTotal)
+ sprintf "%.1f %% (%d / %d)" percent nbInfected nbTotal
+
+ let updateCurrentImageInformation () =
+ match state.CurrentImage with
+ | Some srcImg ->
+ let parasitemiaStr = parasitemiaText (state.ImageParasitemia srcImg)
+ txtImageInformation.Inlines.Clear()
+ txtImageInformation.Inlines.Add(Documents.Run("Parasitemia: ", FontWeight = FontWeights.Bold))
+ txtImageInformation.Inlines.Add(parasitemiaStr)
+ txtImageInformation.Inlines.Add(Documents.LineBreak())
+
+ txtImageInformation.Inlines.Add(Documents.Run("Average erytrocyte diameter: ", FontWeight = FontWeights.Bold))
+ txtImageInformation.Inlines.Add(Documents.Run(srcImg.config.RBCRadius.ToString()))
+ txtImageInformation.Inlines.Add(Documents.LineBreak())
+
+ txtImageInformation.Inlines.Add(Documents.Run("Last analysis: ", FontWeight = FontWeights.Bold))
+ txtImageInformation.Inlines.Add(Documents.Run(if srcImg.dateLastAnalysis.Ticks = 0L then "<Never>" else srcImg.dateLastAnalysis.ToLocalTime().ToString()))
+ | _ -> ()
+
+ let updateGlobalParasitemia () =
+ txtGlobalParasitemia.Text <- parasitemiaText state.GlobalParasitemia
+
+ let updateViewportPreview () =
+ for preview in stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> do
+ let srcImg = preview.Tag :?> SourceImage
+ if Some srcImg = state.CurrentImage then
+ preview.viewport.Visibility <- Visibility.Visible
+
+ let canvasWidth = canvasCurrentImage.ActualWidth * currentScale
+ let canvasHeight = canvasCurrentImage.ActualHeight * currentScale
+ let previewWidth = (preview.ActualWidth - preview.BorderThickness.Left - preview.BorderThickness.Right)
+ let previewHeight = (preview.ActualHeight - preview.BorderThickness.Top - preview.BorderThickness.Bottom)
+
+ let marginLeft = previewWidth * (scrollViewCurrentImage.HorizontalOffset - borderCurrentImage.BorderThickness.Left) / canvasWidth - 2.
+ let marginRight = previewWidth * (canvasWidth - (scrollViewCurrentImage.HorizontalOffset - borderCurrentImage.BorderThickness.Right) - scrollViewCurrentImage.ViewportWidth) / canvasWidth - 2.
+ let marginTop = previewHeight * (scrollViewCurrentImage.VerticalOffset - borderCurrentImage.BorderThickness.Top) / canvasHeight - 2.
+ let marginBottom = previewHeight * (canvasHeight - (scrollViewCurrentImage.VerticalOffset - borderCurrentImage.BorderThickness.Bottom) - scrollViewCurrentImage.ViewportHeight) / canvasHeight - 2.
+
+ preview.viewport.Margin <-
+ Thickness(
+ marginLeft,
+ marginTop,
+ marginRight,
+ marginBottom)
+ else
+ preview.viewport.Visibility <- Visibility.Hidden
+
+ let rec setAsInfected (rbc: RBC) (infected: bool) =
+ state.SetAsInfected rbc infected
+ canvasCurrentImage.Children
+ |> Seq.cast<Views.RBCFrame>
+ |> Seq.iter
+ (fun frame ->
+ if (frame.Tag :?> RBC) = rbc
+ then
+ setRBCFrameStyle rbc frame)
+ updateRBCFramesPreview ()
+ updateCurrentImageInformation ()
+ updateGlobalParasitemia ()
+
+ and RBCFrame (rbc: RBC) : Views.RBCFrame =
+ let frame = RBCFrameFromExisting rbc (Views.RBCFrame())
+ frame.SetValue(Panel.ZIndexProperty, Int32.MaxValue - rbc.num) // To be sure the
+ frame.menuRBCSetAsHealthy.Click.AddHandler(fun obj args -> setAsInfected (frame.Tag :?> RBC) false)
+ frame.menuRBCSetAsInfected.Click.AddHandler(fun obj args -> setAsInfected (frame.Tag :?> RBC) true)
+ frame.ContextMenuOpening.AddHandler(
+ fun obj args ->
+ 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.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)
+ frame
+
+ and updateRBCFramesPreview () =
+ match state.CurrentImage with
+ | Some srcImg ->
+ let mutable currentPreview = 0
+ for rbc in srcImg.rbcs |> List.filter (fun rbc -> displayHealthy || rbc.infected) do
+ let previewInfected =
+ if currentPreview < stackRBC.Children.Count
+ then
+ RBCFrameFromExisting rbc (stackRBC.Children.[currentPreview] :?> Views.RBCFrame)
+ else
+ let f = RBCFrame rbc
+ f.MouseLeftButtonUp.AddHandler(fun obj args -> zoomToRBC (f.Tag :?> RBC))
+ stackRBC.Children.Add(f) |> ignore
+ f
+
+ currentPreview <- currentPreview + 1
+
+ previewInfected.Height <- stackRBC.ActualHeight
+ previewInfected.Width <- stackRBC.ActualHeight * rbc.size.Width / rbc.size.Height
+ previewInfected.border.Fill <- ImageBrush(BitmapSourceConvert.ToBitmapSource(extractRBCPreview srcImg.img rbc))
+
+ stackRBC.Children.RemoveRange(currentPreview, stackRBC.Children.Count - currentPreview)
+ | _ -> ()
+
+ updateViewportPreview ()
+
+ let updateRBCFramesCurrent () =
+ match state.CurrentImage with
+ | Some srcImg ->
+ let mutable currentCanvas = 0
+ for rbc in srcImg.rbcs do
+ let frame =
+ if currentCanvas < canvasCurrentImage.Children.Count
+ then
+ RBCFrameFromExisting rbc (canvasCurrentImage.Children.[currentCanvas] :?> Views.RBCFrame)
+ else
+ let f = RBCFrame rbc
+ f.Root.Opacity <- 0.7
+ canvasCurrentImage.Children.Add(f) |> ignore
+ f
+
+ currentCanvas <- currentCanvas + 1
+
+ Canvas.SetLeft(frame, rbc.center.X - rbc.size.Width / 2.)
+ Canvas.SetTop(frame, rbc.center.Y - rbc.size.Height / 2.)
+
+ for i in currentCanvas .. canvasCurrentImage.Children.Count - 1 do
+ canvasCurrentImage.Children.[i].Visibility <- Visibility.Hidden
+ | _ -> ()
+
+ let saveCurrentDocument () =
+ try
+ if state.FilePath = ""
+ then
+ let dialog = SaveFileDialog(AddExtension = true, DefaultExt = PiaZ.extension, Filter = PiaZ.filter);
+ let res = dialog.ShowDialog()
+ if res.HasValue && res.Value
+ then
+ state.FilePath <- dialog.FileName
+ state.Save()
+ else
+ state.Save()
+ with
+ | :? IOException as ex ->
+ Log.Error(ex.ToString())
+ MessageBox.Show(sprintf "The document cannot be save in '%s'" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
+
+ // Ask the use to save the current document if neccessary.
+ let askSaveCurrent () =
+ 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 ()
+ | _ -> ()
+
+ let updateCurrentImage () =
+ match state.CurrentImage with
+ | Some srcImg ->
+ // Highlight the preview.
+ stackPreviews.Children
+ |> Seq.cast<Views.ImageSourcePreview>
+ |> Seq.iter (fun preview -> preview.border.BorderThickness <- Thickness(if preview.Tag = (srcImg :> Object) then 3. else 0.))
+
+ canvasCurrentImage.Height <- float srcImg.img.Height
+ canvasCurrentImage.Width <- float srcImg.img.Width
+ canvasCurrentImage.Background <- ImageBrush(BitmapSourceConvert.ToBitmapSource(srcImg.img))
+
+ updateRBCFramesCurrent ()
+ updateRBCFramesPreview ()
+ updateCurrentImageInformation ()
+ | None ->
+ stackRBC.Children.Clear()
+ canvasCurrentImage.Children.Clear()
+ canvasCurrentImage.Background <- Brushes.Black
+
+ let setCurrentImage (srcImg: SourceImage) =
+ if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg
+ then
+ state.CurrentImage <- Some srcImg
+ updateCurrentImage ()
+
+ let addPreview (srcImg: SourceImage) =
+ let imgCtrl = Views.ImageSourcePreview(Margin = Thickness(3.))
+
+ imgCtrl.menuRemoveImage.Click.AddHandler(fun obj args ->
+ stackPreviews.Children.Remove(imgCtrl)
+ let srcImg = imgCtrl.Tag :?> SourceImage
+ let currentRemoved = Some srcImg = state.CurrentImage
+ state.RemoveSourceImage srcImg
+ if currentRemoved
+ then
+ updateCurrentImage()
+ stackPreviews.Children |> Seq.cast<Views.ImageSourcePreview> |> Seq.iter (fun imgPreview -> imgPreview.txtImageNumber.Text <- (imgPreview.Tag :?> SourceImage).num.ToString()))
+
+ imgCtrl.Tag <- srcImg
+ imgCtrl.txtImageNumber.Text <- srcImg.num.ToString()
+ let width = 200
+ let height = srcImg.img.Height * width / srcImg.img.Width
+ imgCtrl.imagePreview.Source <- BitmapSourceConvert.ToBitmapSource(srcImg.img.Resize(width, height, Emgu.CV.CvEnum.Inter.Cubic))
+ stackPreviews.Children.Add(imgCtrl) |> ignore
+
+ // Zoom to a mouse position into the control 'imgCtrl'.
+ let zoomTo (mousePos: Point) =
+ let canvasW = canvasCurrentImage.ActualWidth * currentScale
+ let canvasH = canvasCurrentImage.ActualHeight * currentScale
+ let centerX = (mousePos.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
+ let centerY = (mousePos.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
+ scrollViewCurrentImage.ScrollToHorizontalOffset(centerX - scrollViewCurrentImage.ViewportWidth / 2. + borderCurrentImage.BorderThickness.Left)
+ scrollViewCurrentImage.ScrollToVerticalOffset(centerY - scrollViewCurrentImage.ViewportHeight / 2. + borderCurrentImage.BorderThickness.Top)
+
+ imgCtrl.MouseLeftButtonDown.AddHandler(fun obj args ->
+ setCurrentImage (state.SourceImages |> Seq.find (fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
+ imgCtrl.UpdateLayout()
+ zoomTo (args.GetPosition(imgCtrl))
+ imgCtrl.CaptureMouse() |> ignore)
+
+ imgCtrl.MouseMove.AddHandler(fun obj args ->
+ if imgCtrl.IsMouseCaptured
+ then
+ zoomTo (args.GetPosition(imgCtrl)))
+
+ imgCtrl.MouseLeftButtonUp.AddHandler(fun obj args ->
+ if imgCtrl.IsMouseCaptured
+ then
+ imgCtrl.ReleaseMouseCapture())
+
+ let updatePreviews () =
+ stackPreviews.Children.Clear ()
+ for srcImg in state.SourceImages do
+ addPreview srcImg
+ updateCurrentImage ()
+
+ let updateGUI () =
+ txtPatient.Text <- state.PatientID
+ updatePreviews ()
+ updateGlobalParasitemia ()
+
+ let loadFile (filepath: string) =
+ askSaveCurrent ()
+ let previousFilePath = state.FilePath
+ try
+ state.FilePath <- filepath
+ state.Load()
+ updateGUI ()
+ with
+ | :? IOException as ex ->
+ Log.Error(ex.ToString())
+ state.FilePath <- previousFilePath
+ MessageBox.Show(sprintf "The document cannot be loaded from '%s'" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
+
+ txtPatient.LostFocus.AddHandler(fun obj args -> state.PatientID <- txtPatient.Text)
+
+ menuExit.Click.AddHandler(fun obj args ->
+ askSaveCurrent ()
+ mainWindow.Root.Close())
+
+ menuSaveFile.Click.AddHandler(fun obj args -> saveCurrentDocument ())
+
+ menuLoadFile.Click.AddHandler(fun obj args ->
+ // TODO: if current state not saved and not empty, ask to save it.
+ let dialog = OpenFileDialog(Filter = PiaZ.filter)
+ let res = dialog.ShowDialog()
+ if res.HasValue && res.Value
+ then loadFile dialog.FileName)
+
+ menuNewFile.Click.AddHandler(fun obj args ->
+ askSaveCurrent ()
+ state.Reset()
+ updateGUI())
+
+ menuAddSourceImage.Click.AddHandler(fun obj args ->
+ let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
+ let res = dialog.ShowDialog()
+ if res.HasValue && res.Value
+ then
+ let noSourceImage = state.SourceImages.Count() = 0
+
+ for filename in dialog.FileNames do
+ let srcImg = state.AddSourceImage filename defaultConfig
+ addPreview srcImg
+
+ updateGlobalParasitemia ()
+
+ if noSourceImage
+ then
+ updateCurrentImage ())
+
+ menuAnalysis.SubmenuOpened.AddHandler(fun obj args -> menuStartAnalysis.IsEnabled <- state.SourceImages.Count() > 0)
+
+ menuStartAnalysis.Click.AddHandler(fun obj args ->
+ if Analysis.showWindow mainWindow.Root state
+ then
+ updateGlobalParasitemia ()
+ updateCurrentImage ())
+
+ menuHightlightRBC.Click.AddHandler(fun obj args ->
+ displayHealthy <- menuHightlightRBC.IsChecked
+ updateRBCFramesPreview ()
+ updateRBCFramesCurrent ())
+
+ menuAbout.Click.AddHandler(fun obj args -> About.showWindow mainWindow.Root)
+
+ // Zoom on the current image.
+ let adjustCurrentImageBorders (deltaX: float) (deltaY: float) =
+ borderCurrentImage.BorderThickness <-
+ Thickness(
+ (scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
+ (scrollViewCurrentImage.ViewportHeight + deltaY) / 2.,
+ (scrollViewCurrentImage.ViewportWidth + deltaX) / 2.,
+ (scrollViewCurrentImage.ViewportHeight + deltaY) / 2.)
+
+ 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
+ adjustCurrentImageBorders 0.0 0.0
+ // Center the view at the center of the image initialy.
+ scrollViewCurrentImage.UpdateLayout()
+ scrollViewCurrentImage.ScrollToHorizontalOffset(borderCurrentImage.ActualWidth / 2. - scrollViewCurrentImage.ViewportWidth / 2.)
+ scrollViewCurrentImage.ScrollToVerticalOffset(borderCurrentImage.ActualHeight / 2. - scrollViewCurrentImage.ViewportHeight / 2.))
+
+ 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
+ scrollViewCurrentImage.ScrollToHorizontalOffset(scrollViewCurrentImage.HorizontalOffset + deltaX / 8.)
+ scrollViewCurrentImage.ScrollToVerticalOffset(scrollViewCurrentImage.VerticalOffset + deltaY / 8.))
+
+ let mutable maxScale = 4.
+ let mutable minScale = 0.25
+ let currentImageScaleTransform = ScaleTransform()
+ canvasCurrentImage.LayoutTransform <- currentImageScaleTransform
+ 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
+ let previousScale = currentScale
+ currentScale <-
+ let newScale = currentScale * scaleFactor
+ if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
+ let realScaleFactor = currentScale / previousScale
+
+ let centerX = scrollViewCurrentImage.HorizontalOffset + scrollViewCurrentImage.ViewportWidth / 2. - borderCurrentImage.BorderThickness.Left
+ let centerY = scrollViewCurrentImage.VerticalOffset + scrollViewCurrentImage.ViewportHeight / 2. - borderCurrentImage.BorderThickness.Top
+
+ currentImageScaleTransform.ScaleX <- currentScale
+ currentImageScaleTransform.ScaleY <- currentScale
+
+ scrollViewCurrentImage.ScrollToHorizontalOffset(centerX * realScaleFactor - scrollViewCurrentImage.ViewportWidth / 2. + borderCurrentImage.BorderThickness.Left)
+ scrollViewCurrentImage.ScrollToVerticalOffset(centerY * realScaleFactor - scrollViewCurrentImage.ViewportHeight / 2. + borderCurrentImage.BorderThickness.Top)
+
+ args.Handled <- true)
+
+ // Pan on the current image.
+ let mutable scrollStartPosition = Point(0., 0.)
+ let mutable scrollStartOffsetX = 0.
+ let mutable scrollStartOffsetY = 0.
+ borderCurrentImage.PreviewMouseLeftButtonDown.AddHandler(fun obj args ->
+ scrollStartPosition <- args.GetPosition(scrollViewCurrentImage)
+ scrollStartOffsetX <- scrollViewCurrentImage.HorizontalOffset
+ scrollStartOffsetY <- scrollViewCurrentImage.VerticalOffset
+ borderCurrentImage.Cursor <- Input.Cursors.ScrollAll
+ borderCurrentImage.CaptureMouse() |> ignore
+ args.Handled <- true)
+
+ borderCurrentImage.PreviewMouseMove.AddHandler(fun obj args ->
+ if borderCurrentImage.IsMouseCaptured
+ then
+ let position = args.GetPosition(scrollViewCurrentImage)
+ let deltaX = scrollStartPosition.X - position.X
+ let deltaY = scrollStartPosition.Y - position.Y
+ scrollViewCurrentImage.ScrollToHorizontalOffset(deltaX + scrollStartOffsetX)
+ scrollViewCurrentImage.ScrollToVerticalOffset(deltaY + scrollStartOffsetY)
+
+ args.Handled <- true)
+
+ borderCurrentImage.PreviewMouseLeftButtonUp.AddHandler(fun obj args ->
+ if borderCurrentImage.IsMouseCaptured
+ then
+ borderCurrentImage.Cursor <- Input.Cursors.Arrow
+ borderCurrentImage.ReleaseMouseCapture()
+ args.Handled <- true)
+
+ // Viewport preview.
+ scrollViewCurrentImage.ScrollChanged.AddHandler(fun obj args -> updateViewportPreview ())
+
+ mainWindow.Root.Show()
+
+ match fileToOpen with
+ | Some filepath -> loadFile filepath
+ | None -> ()
+
+ app.Run()
\ No newline at end of file
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>70838e65-f211-44fc-b28f-0ed1ca6e850f</ProjectGuid>
+ <OutputType>WinExe</OutputType>
+ <RootNamespace>ParasitemiaUI</RootNamespace>
+ <AssemblyName>ParasitemiaUI</AssemblyName>
+ <TargetFrameworkVersion>v4.5.2</TargetFrameworkVersion>
+ <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
+ <TargetFSharpCoreVersion>4.4.0.0</TargetFSharpCoreVersion>
+ <Name>ParasitemiaUI</Name>
+ <NuGetPackageImportStamp>
+ </NuGetPackageImportStamp>
+ <TargetFrameworkProfile />
+ <Win32Resource>resources.res</Win32Resource>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x64</PlatformTarget>
+ <DocumentationFile>bin\Debug\ParasitemiaUI.XML</DocumentationFile>
+ <Prefer32Bit>false</Prefer32Bit>
+ <StartArguments>--folder "../../../Images/debug" --output "../../../Images/output" --debug</StartArguments>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'DebugGUI|AnyCPU' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x64</PlatformTarget>
+ <DocumentationFile>bin\Debug\ParasitemiaUI.XML</DocumentationFile>
+ <Prefer32Bit>false</Prefer32Bit>
+ <StartArguments>--output "../../../Images/output" --debug</StartArguments>
+ <OutputPath>bin\DebugGUI\</OutputPath>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <Tailcalls>true</Tailcalls>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>AnyCPU</PlatformTarget>
+ <DocumentationFile>bin\Release\ParasitemiaUI.XML</DocumentationFile>
+ <Prefer32Bit>false</Prefer32Bit>
+ <StartArguments>--folder "../../../Images/release" --output "../../../Images/output" --debug</StartArguments>
+ </PropertyGroup>
+ <PropertyGroup>
+ <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+ </PropertyGroup>
+ <Choose>
+ <When Condition="'$(VisualStudioVersion)' == '11.0'">
+ <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
+ <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
+ </PropertyGroup>
+ </When>
+ <Otherwise>
+ <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
+ <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
+ </PropertyGroup>
+ </Otherwise>
+ </Choose>
+ <Import Project="$(FSharpTargetsPath)" />
+ <ItemGroup>
+ <Compile Include="AssemblyInfo.fs" />
+ <Resource Include="Resources\icon.ico" />
+ <Resource Include="XAML\NumericUpDown.xaml" />
+ <Compile Include="XAML\NumericUpDown.xaml.fs" />
+ <Resource Include="XAML\ImageSourcePreview.xaml" />
+ <Compile Include="XAML\ImageSourcePreview.xaml.fs" />
+ <Resource Include="XAML\ImageSourceSelection.xaml" />
+ <Compile Include="XAML\ImageSourceSelection.xaml.fs" />
+ <Resource Include="XAML\RBCFrame.xaml" />
+ <Compile Include="XAML\RBCFrame.xaml.fs" />
+ <Resource Include="XAML\AnalysisWindow.xaml" />
+ <Compile Include="XAML\AnalysisWindow.xaml.fs" />
+ <Resource Include="XAML\AboutWindow.xaml" />
+ <Compile Include="XAML\AboutWindow.xaml.fs" />
+ <Resource Include="XAML\MainWindow.xaml" />
+ <Compile Include="XAML\MainWindow.xaml.fs" />
+ <Compile Include="Types.fs" />
+ <Compile Include="PiaZ.fs" />
+ <Compile Include="State.fs" />
+ <Compile Include="About.fs" />
+ <Compile Include="Analysis.fs" />
+ <Compile Include="GUI.fs" />
+ <None Include="App.config" />
+ <Content Include="packages.config" />
+ <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>
+ <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), 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>
+ </Reference>
+ <Reference Include="FsXaml.Wpf">
+ <HintPath>..\packages\FsXaml.Wpf.0.9.9\lib\net45\FsXaml.Wpf.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="FsXaml.Wpf.TypeProvider">
+ <HintPath>..\packages\FsXaml.Wpf.0.9.9\lib\net45\FsXaml.Wpf.TypeProvider.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="mscorlib" />
+ <Reference Include="Newtonsoft.Json">
+ <HintPath>..\packages\Newtonsoft.Json.8.0.2\lib\net45\Newtonsoft.Json.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="PresentationCore" />
+ <Reference Include="PresentationFramework" />
+ <Reference Include="System" />
+ <Reference Include="System.Core" />
+ <Reference Include="System.Data" />
+ <Reference Include="System.Data.DataSetExtensions" />
+ <Reference Include="System.Data.Linq" />
+ <Reference Include="System.Drawing" />
+ <Reference Include="System.IO.Compression" />
+ <Reference Include="System.IO.Compression.FileSystem" />
+ <Reference Include="System.Numerics" />
+ <Reference Include="System.Windows.Interactivity">
+ <HintPath>..\packages\Expression.Blend.Sdk.1.0.2\lib\net45\System.Windows.Interactivity.dll</HintPath>
+ <Private>True</Private>
+ </Reference>
+ <Reference Include="System.Xaml" />
+ <Reference Include="System.Xml" />
+ <Reference Include="System.Xml.Linq" />
+ <Reference Include="WindowsBase" />
+ </ItemGroup>
+ <ItemGroup>
+ <ProjectReference Include="..\Logger\Logger.fsproj">
+ <Name>Logger</Name>
+ <Project>{a4f183ae-562a-4bad-88e6-658b4ce15dc3}</Project>
+ <Private>True</Private>
+ </ProjectReference>
+ <ProjectReference Include="..\ParasitemiaCore\ParasitemiaCore.fsproj">
+ <Name>ParasitemiaCore</Name>
+ <Project>{0f8a85f4-9328-40c3-b8ff-44fb39ceb01f}</Project>
+ <Private>True</Private>
+ </ProjectReference>
+ <ProjectReference Include="..\WPF\WPF.csproj">
+ <Name>WPF</Name>
+ <Project>{314fd78e-870e-4794-bb16-ea4586f2abdb}</Project>
+ <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>
+ </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.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
\ No newline at end of file
--- /dev/null
+// ParasitemIA Zipped document format.
+module ParasitemiaUI.PiaZ
+
+open System
+open System.Windows
+open System.IO
+open System.IO.Compression
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Newtonsoft.Json
+open Newtonsoft.Json.Converters
+
+open Types
+
+let extension = ".piaz"
+let filter = "PIA|*.piaz"
+
+// Information associated to a document.
+type JSONInformation = {
+ patientID: string
+}
+
+// Information associated to each images.
+type JSONSourceImage = {
+ num: int
+ RBCRadius: float32 // The RBC Radius found by granulometry.
+ parameters: ParasitemiaCore.Config.Parameters
+ dateLastAnalysis: DateTime
+ rbcs: RBC List
+}
+
+type DocumentData = {
+ patientID: string
+ images: SourceImage list
+}
+
+let mainEntryName = "info.json"
+let imageExtension = ".tiff"
+
+/// <summary>
+/// Save a document in a give file path. The file may already exist.
+/// </summary>
+/// <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) =
+ use file = ZipFile.Open(filePath, ZipArchiveMode.Update)
+
+ for e in List.ofSeq file.Entries do // 'ofSeq' to not iterate a collection currently modified.
+ e.Delete()
+
+ // Main JSON file.
+ let mainEntry = file.CreateEntry(mainEntryName, CompressionLevel.Fastest)
+ use mainEntryWriter = new StreamWriter(mainEntry.Open())
+ mainEntryWriter.Write(JsonConvert.SerializeObject({ JSONInformation.patientID = data.patientID }))
+
+ // Write each images and the associated information.
+ for srcImg in data.images do
+ let imgFilename = (string srcImg.num) + imageExtension
+ let imgEntry = file.CreateEntry(imgFilename, CompressionLevel.NoCompression) // FIXME: It seems a compression is applied to this file despite of the 'NoCompression' flag.
+ srcImg.img.ToBitmap().Save(imgEntry.Open(), System.Drawing.Imaging.ImageFormat.Tiff)
+
+ let imgJSONEntry = file.CreateEntry(imgFilename + ".json", CompressionLevel.Fastest)
+ use imgJSONFileWriter = new StreamWriter(imgJSONEntry.Open())
+ imgJSONFileWriter.Write(JsonConvert.SerializeObject({ num = srcImg.num; RBCRadius = srcImg.config.RBCRadius.Pixel; parameters = srcImg.config.Parameters; dateLastAnalysis = srcImg.dateLastAnalysis; rbcs = srcImg.rbcs }))
+
+/// <summary>
+/// Load document from a give file path.
+/// </summary>
+/// <param name="filePath"></param>
+/// <exception cref="System.IOException">If the file cannot be read</exception>
+let load (filePath: string) : DocumentData =
+ use file = ZipFile.Open(filePath, ZipArchiveMode.Read)
+
+ let mainEntry = file.GetEntry(mainEntryName)
+ use mainEntryReader = new StreamReader(mainEntry.Open())
+ let info = JsonConvert.DeserializeObject<JSONInformation>(mainEntryReader.ReadToEnd())
+
+ { patientID = info.patientID
+ images = [ let mutable imgNum = 0
+ for imgEntry in file.Entries do
+ if imgEntry.Name.EndsWith(imageExtension)
+ then
+ let img = new Image<Bgr, byte>(new System.Drawing.Bitmap(imgEntry.Open(), false)) // FIXME: Should we dispose the bitmap?
+ imgNum <- imgNum + 1
+ let imgEntry = file.GetEntry(imgEntry.Name + ".json")
+ use imgEntryFileReader = new StreamReader(imgEntry.Open())
+ let imgInfo = JsonConvert.DeserializeObject<JSONSourceImage>(imgEntryFileReader.ReadToEnd())
+ let config = ParasitemiaCore.Config.Config(imgInfo.parameters)
+ config.SetRBCRadius imgInfo.RBCRadius
+ yield { num = imgNum
+ config = config
+ dateLastAnalysis = imgInfo.dateLastAnalysis
+ img = img
+ rbcs = imgInfo.rbcs } ] }
\ No newline at end of file
--- /dev/null
+module ParasitemiaUI.Main
+
+open System
+open System.IO
+open System.Threading
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Logger
+
+open ParasitemiaCore.Utils
+open ParasitemiaCore.Config
+
+type Input =
+ | File of string
+ | Dir of string
+
+type RunningMode =
+ | CmdLine of Input * string // A file or a directory to process and the output directory.
+ | Window of string option // An optional path to a file to open can be given in window mode.
+
+type Arguments = RunningMode * bool
+
+let parseArgs (args: string[]) : Arguments =
+
+ let output = Array.tryFindIndex ((=) "--output") args
+
+ let runningMode =
+ match Array.tryFindIndex ((=) "--folder") args, output with
+ | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
+ CmdLine ((Dir args.[i+1]), args.[i_output + 1])
+ | _ ->
+ match Array.tryFindIndex ((=) "--file") args, output with
+ | Some i, Some i_output when i < args.Length - 2 && i_output < args.Length - 2 ->
+ CmdLine ((File args.[i+1]), args.[i_output + 1])
+ |_ ->
+ Window (if args.Length > 0 && not (args.[0].StartsWith("--")) then Some args.[0] else None)
+
+ runningMode, Array.exists ((=) "--debug") args
+
+[<EntryPoint>]
+[<STAThread()>]
+let main args =
+ try
+ Log.User("Starting of Parasitemia UI ...")
+
+ let result =
+ match parseArgs args with
+ | mode, debug ->
+ let config = Config(defaultParameters)
+
+ match mode with
+ | CmdLine (input, output) ->
+ if debug
+ then
+ config.Debug <- DebugOn output
+
+ Directory.CreateDirectory output |> ignore
+
+ use logFile = new StreamWriter(new FileStream(Path.Combine(output, "log.txt"), FileMode.Append, FileAccess.Write))
+ Log.AddListener({ new IListener with member this.NewEntry mess severity = logFile.WriteLine(mess) })
+
+ Log.User (sprintf "=== New run : %A %A ===" DateTime.Now (if debug then "[DEBUG]" else "[RELEASE]"))
+
+ let files = match input with
+ | File file -> [ file ]
+ | Dir dir -> Directory.EnumerateFiles dir |> List.ofSeq
+
+ use resultFile = new StreamWriter(new FileStream(Path.Combine(output, "results.txt"), FileMode.Append, FileAccess.Write))
+
+
+ let images = [ for file in files -> Path.GetFileNameWithoutExtension(FileInfo(file).Name), config.Copy(), new Image<Bgr, byte>(file) ]
+
+ Log.LogWithTime("Whole analyze", Severity.USER, (fun () ->
+ let results = ParasitemiaCore.Analysis.doMultipleAnalysis images None
+
+ for id, cells in results do
+ let config = images |> List.pick (fun (id', config', _) -> if id' = id then Some config' else None)
+ let total, infected = countCells cells
+ fprintf resultFile "File: %s %d %d %.2f (diameter: %A)\n" id total infected (100. * (float infected) / (float total)) config.RBCRadius))
+ 0
+
+ | Window fileToOpen ->
+ if debug then config.Debug <- DebugOn "."
+ GUI.run config fileToOpen
+
+ Log.User("Parasitemia UI closed")
+ result
+
+ with
+ | _ as ex ->
+ Log.Fatal("Error: {0}", ex)
+ 1
\ No newline at end of file
--- /dev/null
+module ParasitemiaUI.State
+
+open System
+open System.Collections.Generic
+open System.Windows
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+open Types
+
+type State () =
+ 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 this.PatientID
+ with get () : string = patientID
+ and set id =
+ if id <> patientID
+ then
+ alteredSinceLastSave <- true
+ patientID <- id
+
+ 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.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
+ alteredSinceLastSave <- true
+ rbc.infected <- infected
+ rbc.setManually <- not rbc.setManually
+
+ /// <summary>
+ /// Save the current state. 'FilePath' must have been defined.
+ /// </summary>
+ /// <exception cref="System.IOException">If the file cannot be saved</exception>
+ member this.Save () =
+ let data = { PiaZ.DocumentData.patientID = this.PatientID; PiaZ.DocumentData.images = List.ofSeq sourceImages }
+ PiaZ.save this.FilePath data
+ alteredSinceLastSave <- false
+
+ /// <summary>
+ /// Load the current state. 'FilePath' must have been defined.
+ /// </summary>
+ /// <exception cref="System.IOException">If the file cannot be laoded</exception>
+ member this.Load () =
+ let data = PiaZ.load this.FilePath
+ this.PatientID <- data.patientID
+ sourceImages.Clear()
+ sourceImages.InsertRange(0, data.images)
+ if sourceImages.Count > 0
+ then this.CurrentImage <- Some sourceImages.[0]
+ alteredSinceLastSave <- false
+
+ member this.AddSourceImage (filePath: string) (defaultConfig: ParasitemiaCore.Config.Config) : SourceImage =
+ let srcImg = { num = sourceImages.Count + 1; config = defaultConfig.Copy(); dateLastAnalysis = DateTime(0L); rbcs = []; img = new Image<Bgr, byte>(filePath) }
+ sourceImages.Add(srcImg)
+ if sourceImages.Count = 1
+ then this.CurrentImage <- Some sourceImages.[0]
+ alteredSinceLastSave <- true
+ srcImg
+
+ member this.RemoveSourceImage (srcImg: SourceImage) =
+ let isCurrent =
+ match this.CurrentImage with
+ | Some srcImg' -> srcImg = srcImg'
+ | _ -> false
+
+ if sourceImages.Remove(srcImg)
+ then
+ alteredSinceLastSave <- true
+ 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.SetResult (imgNum: int) (cells: ParasitemiaCore.Types.Cell list) =
+ let sourceImage = sourceImages.Find(fun srcImg -> srcImg.num = imgNum)
+
+ let w = sourceImage.img.Width
+ let h = sourceImage.img.Height
+
+ sourceImage.dateLastAnalysis <- DateTime.UtcNow
+
+ // 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 getPreviousRBC (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
+ |> List.filter (fun cell -> match cell.cellClass with ParasitemiaCore.Types.HealthyRBC | ParasitemiaCore.Types.InfectedRBC -> true | _ -> false )
+ |> List.sortByDescending (fun cell -> cell.infectedArea, (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 =
+ match getPreviousRBC center with
+ | Some rbc -> rbc.infected, true
+ | _ -> cell.cellClass = ParasitemiaCore.Types.InfectedRBC, false
+
+ { num = i + 1
+ infected = infected
+ setManually = setManually
+ center = center
+ size = Size(float cell.elements.Width, float cell.elements.Height)
+ infectedArea = cell.infectedArea })
+
+ alteredSinceLastSave <- true
+
+ member this.SourceImages : SourceImage seq =
+ sourceImages :> SourceImage seq
+
+ member this.Reset () =
+ this.PatientID <- ""
+ this.FilePath <- ""
+ this.CurrentImage <- None
+ sourceImages.Clear()
+ alteredSinceLastSave <- false
\ No newline at end of file
--- /dev/null
+module ParasitemiaUI.Types
+
+open System
+open System.Windows
+
+open Emgu.CV
+open Emgu.CV.Structure
+
+type RBC = {
+ num: int
+
+ mutable infected: bool
+ mutable setManually: bool
+
+ center: Point
+ size: Size
+ infectedArea: int }
+
+type SourceImage = {
+ mutable num: int
+ mutable config: ParasitemiaCore.Config.Config
+ mutable dateLastAnalysis: DateTime // UTC.
+ img: Image<Bgr, byte>
+ mutable rbcs: RBC list }
\ No newline at end of file
--- /dev/null
+<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d"
+ x:Name="AboutWindow" Height="200.969" Width="282.313" MinHeight="100" MinWidth="100" Title="About" Icon="pack://application:,,,/Resources/icon.ico">
+ <Grid>
+ <Grid.RowDefinitions>
+ <RowDefinition Height="Auto"/>
+ <RowDefinition Height="Auto"/>
+ <RowDefinition/>
+ </Grid.RowDefinitions>
+ <Image HorizontalAlignment="Left" Height="64" VerticalAlignment="Top" Width="64" Margin="6" Source="pack://application:,,,/Resources/icon.ico"/>
+ <TextBlock x:Name="txtAbout" HorizontalAlignment="Left" Margin="6" Grid.Row="1" TextWrapping="Wrap">
+ <Bold>Parasitemia </Bold>
+ <LineBreak />
+ <Hyperlink NavigateUri="http://www.hes-so.ch">HES-SO</Hyperlink> /
+ <Hyperlink NavigateUri="http://www.chuv.ch/">CHUV</Hyperlink>
+ <LineBreak />
+ Grégory Burri
+ </TextBlock>
+ <Button x:Name="butClose" Content="Close" HorizontalAlignment="Right" Margin="3" VerticalAlignment="Bottom" Width="75" Grid.Row="2" Height="20"/>
+ </Grid>
+</Window>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open FsXaml
+
+type AboutWindow = XAML<"XAML/AboutWindow.xaml">
+
--- /dev/null
+<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d"
+ x:Name="AnalysisWindow" Height="453" Width="515" MinHeight="100" MinWidth="100" Title="Analysis" Icon="pack://application:,,,/Resources/icon.ico">
+ <Grid>
+ <Grid.RowDefinitions>
+ <RowDefinition Height="50*"/>
+ <RowDefinition Height="30"/>
+ <RowDefinition Height="20*"/>
+ <RowDefinition Height="Auto"/>
+ </Grid.RowDefinitions>
+ <ScrollViewer x:Name="scrollImagesSourceSelection" VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Hidden" Grid.Row="0" Margin="3" >
+ <StackPanel x:Name="stackImagesSourceSelection" />
+ </ScrollViewer>
+ <ProgressBar x:Name="progress" Grid.Row="1" Margin="3" Minimum="0" Maximum="100" />
+ <ScrollViewer x:Name="scrollLog" Grid.Row="2" Margin="3" HorizontalScrollBarVisibility="Auto">
+ <TextBlock x:Name="textLog" />
+ </ScrollViewer>
+ <Grid Grid.Row="3">
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition/>
+ <ColumnDefinition/>
+ </Grid.ColumnDefinitions>
+ <Button x:Name="butStart" Content="Start analysis" Margin="3" Grid.Column="0"/>
+ <Button x:Name="butClose" Content="Close" Margin="3" Grid.Column="1"/>
+ </Grid>
+ </Grid>
+</Window>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open FsXaml
+
+type AnalysisWindow = XAML<"XAML/AnalysisWindow.xaml">
+
--- /dev/null
+<UserControl
+ xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:fsxaml="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d" d:DesignWidth="119.223" d:DesignHeight="84.911"
+ >
+ <Border x:Name="border" ClipToBounds="True" BorderBrush="{DynamicResource {x:Static SystemColors.HighlightBrushKey}}">
+ <Grid x:Name="grid">
+ <Grid.ContextMenu>
+ <ContextMenu>
+ <MenuItem x:Name="menuRemoveImage" Header="_Remove image" />
+ </ContextMenu>
+ </Grid.ContextMenu>
+ <Image x:Name="imagePreview" />
+ <Border HorizontalAlignment="Right" VerticalAlignment="Bottom" Background="#4C000000" Margin="0,0,3,3" CornerRadius="5" >
+ <TextBlock x:Name="txtImageNumber" Padding="2" Text="42" Foreground="White" />
+ </Border>
+ <Rectangle x:Name="viewport" Margin="24,30,71,26" Stroke="#BFFFFF00" RenderTransformOrigin="0.5,0.5" Visibility="Hidden"/>
+ </Grid>
+ </Border>
+</UserControl>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open System
+open System.Windows
+open System.Windows.Data
+open System.Windows.Input
+
+open FSharp.ViewModule
+open FsXaml
+
+type ImageSourcePreview = XAML<"XAML/ImageSourcePreview.xaml", true>
+
+(* type ImageSourcePreviewController() =
+ inherit UserControlViewController<ImageSourcePreview>() *)
+
+(* type ImageSourcePreviewViewModel() =
+ inherit ViewModelBase() *)
--- /dev/null
+<UserControl
+ xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:fsxaml="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d" d:DesignWidth="349.723" d:DesignHeight="118.911"
+ >
+ <UserControl.Background>
+ <SolidColorBrush Color="{DynamicResource {x:Static SystemColors.ControlColorKey}}"/>
+ </UserControl.Background>
+ <Grid x:Name="gridMain">
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition Width="100"/>
+ <ColumnDefinition/>
+ </Grid.ColumnDefinitions>
+ <Grid x:Name="gridImage" Grid.ColumnSpan="1" VerticalAlignment="Top">
+ <Image x:Name="imagePreview" />
+ <CheckBox x:Name="chkSelection" HorizontalAlignment="Left" VerticalAlignment="Top" Margin="3,3,0,0"/>
+ <Border HorizontalAlignment="Right" VerticalAlignment="Bottom" Background="#4C000000" Margin="0,0,3,3" CornerRadius="5" >
+ <TextBlock x:Name="txtImageNumber" Padding="2" Text="42" Foreground="White" />
+ </Border>
+ <Rectangle x:Name="viewport" Margin="24,30,71,26" Stroke="#BFFFFF00" RenderTransformOrigin="0.5,0.5" Visibility="Hidden"/>
+ </Grid>
+ <Grid Grid.Column="1">
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition Width="Auto"/>
+ <ColumnDefinition/>
+ </Grid.ColumnDefinitions>
+ <Grid.RowDefinitions>
+ <RowDefinition Height="Auto"/>
+ <RowDefinition Height="Auto"/>
+ <RowDefinition Height="1*"/>
+ </Grid.RowDefinitions>
+ <Label Content="Last analysis" Grid.Column="0" Grid.Row="0" Margin="10,0,3,0" />
+ <Label Content="Resolution [PPI]" Grid.Column="0" Grid.Row="1" Margin="10,0,3,0" />
+ <Label x:Name="lblDateLastAnalysis" Grid.Column="1" Margin="3,0,3,0"/>
+ <Grid Grid.Column="1" Grid.Row="1">
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition/>
+ <ColumnDefinition Width="Auto"/>
+ </Grid.ColumnDefinitions>
+ <TextBox x:Name="txtResolution" Margin="3" Text="" Grid.Column="0" />
+ <Button x:Name="butDefaultResolutions" Content="Defaults" Grid.Column="1" Margin="3">
+ <Button.ContextMenu>
+ <ContextMenu>
+ <MenuItem x:Name="menuZoom50X" Header="_230'000 PPI (50X)" />
+ <MenuItem x:Name="menuZoom100X" Header="_460'000 PPI (100X)" />
+ </ContextMenu>
+ </Button.ContextMenu>
+ <Button.Style>
+ <Style TargetType="{x:Type Button}">
+ <Style.Triggers>
+ <EventTrigger RoutedEvent="Click">
+ <EventTrigger.Actions>
+ <BeginStoryboard>
+ <Storyboard>
+ <BooleanAnimationUsingKeyFrames Storyboard.TargetProperty="ContextMenu.IsOpen">
+ <DiscreteBooleanKeyFrame KeyTime="0:0:0" Value="True"/>
+ </BooleanAnimationUsingKeyFrames>
+ </Storyboard>
+ </BeginStoryboard>
+ </EventTrigger.Actions>
+ </EventTrigger>
+ </Style.Triggers>
+ </Style>
+ </Button.Style>
+ </Button>
+ </Grid>
+ </Grid>
+ </Grid>
+</UserControl>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open System
+open System.Windows
+open System.Windows.Data
+open System.Windows.Input
+
+open FSharp.ViewModule
+open FsXaml
+
+type ImageSourceSelection = XAML<"XAML/ImageSourceSelection.xaml", true>
+
+(* type ImageSourcePreviewController() =
+ inherit UserControlViewController<ImageSourcePreview>() *)
+
+(* type ImageSourcePreviewViewModel() =
+ inherit ViewModelBase() *)
--- /dev/null
+<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d"
+ x:Name="MainWindow" Height="681.888" Width="787.61" MinHeight="200" MinWidth="300" Title="Parasitemia" Icon="pack://application:,,,/Resources/icon.ico">
+ <DockPanel x:Name="dockPanelMain" LastChildFill="True">
+ <Menu DockPanel.Dock="Top">
+ <MenuItem Header="_File">
+ <MenuItem x:Name="menuNew" Header="_New" />
+ <MenuItem x:Name="menuOpen" Header="_Open" />
+ <MenuItem x:Name="menuSave" Header="_Save" />
+ <Separator />
+ <MenuItem x:Name="menuExit" Header="_Exit" />
+ </MenuItem>
+ <MenuItem Header="_Images">
+ <MenuItem x:Name="menuAddSourceImage" Header="_Add a source image" />
+ </MenuItem>
+ <MenuItem x:Name="menuAnalysis" Header="_Analysis">
+ <MenuItem x:Name="menuStartAnalysis" Header="_Show analysis window" />
+ </MenuItem>
+ <MenuItem x:Name="menuView" Header="_View">
+ <MenuItem x:Name="menuHightlightRBC" Header="_Highlight healthy erytrocytes" IsCheckable="True" />
+ </MenuItem>
+ <MenuItem x:Name="menuHelp" Header="_Help">
+ <MenuItem x:Name="menuAbout" Header="_About" />
+ </MenuItem>
+ </Menu>
+ <Grid x:Name="gridMain">
+ <Grid.RowDefinitions>
+ <RowDefinition Height="Auto"/>
+ <RowDefinition/>
+ </Grid.RowDefinitions>
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition Width="180"/>
+ <ColumnDefinition/>
+ </Grid.ColumnDefinitions>
+ <Grid x:Name="gridGlobalInfo" Grid.ColumnSpan="2" Margin="3,3,3,3" >
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition Width="101"/>
+ <ColumnDefinition Width="21"/>
+ <ColumnDefinition/>
+ </Grid.ColumnDefinitions>
+ <Grid.RowDefinitions>
+ <RowDefinition Height="Auto"/>
+ <RowDefinition Height="Auto"/>
+ </Grid.RowDefinitions>
+ <Label x:Name="lblPatient" Margin="10,0,3,0 " Content="Patient ID" Grid.ColumnSpan="2"/>
+ <Label x:Name="lblGlobalParasitemia" Margin="10,0,3,0" Content="Global parasitemia" Grid.Row="1" Grid.ColumnSpan="2" />
+ <TextBox x:Name="txtPatient" Grid.Column="2" Margin="3,4,10,4" TextWrapping="Wrap" VerticalAlignment="Center" />
+ <TextBox x:Name="txtGlobalParasitemia" Grid.Column="2" Grid.Row="1" Margin="3,4,10,4" TextWrapping="Wrap" VerticalAlignment="Center" IsReadOnly="True" />
+ </Grid>
+ <Border BorderBrush="Black" BorderThickness="1" Margin="3" Grid.Row="1" >
+ <ScrollViewer x:Name="scrollPreviews" VerticalScrollBarVisibility="Auto" >
+ <StackPanel x:Name="stackPreviews" />
+ </ScrollViewer>
+ </Border>
+ <Grid Grid.Column="2" Grid.Row="2">
+ <Grid.RowDefinitions>
+ <RowDefinition Height="100"/>
+ <RowDefinition/>
+ <RowDefinition Height="Auto"/>
+ </Grid.RowDefinitions>
+ <ScrollViewer x:Name="scrollViewCurrentImage" Grid.Row="1" VerticalScrollBarVisibility="Visible" HorizontalScrollBarVisibility="Visible" Background="Black" MinHeight="100" MinWidth="100">
+ <Border x:Name="borderCurrentImage" BorderBrush="Transparent">
+ <Canvas x:Name="canvasCurrentImage" Height="100" Width="100" />
+ </Border>
+ </ScrollViewer>
+ <ScrollViewer x:Name="scrollRBC" VerticalScrollBarVisibility="Hidden" HorizontalScrollBarVisibility="Visible" Grid.RowSpan="1" Margin="3">
+ <StackPanel x:Name="stackRBC" Orientation="Horizontal" />
+ </ScrollViewer>
+ <TextBlock x:Name="txtImageInformation" Grid.Row="2" TextWrapping="Wrap" Margin="3" />
+ </Grid>
+ </Grid>
+ </DockPanel>
+</Window>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open FsXaml
+
+type MainWindow = XAML<"XAML/MainWindow.xaml">
+
--- /dev/null
+<UserControl
+ xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d" d:DesignWidth="259.5" d:DesignHeight="45.5"
+ >
+ <Grid>
+ <Grid.RowDefinitions>
+ <RowDefinition />
+ <RowDefinition />
+ </Grid.RowDefinitions>
+ <Grid.ColumnDefinitions>
+ <ColumnDefinition Width="*" />
+ <ColumnDefinition Width="Auto" />
+ </Grid.ColumnDefinitions>
+ <Button x:Name="upButton" Grid.Column="1" Content="^"/>
+ <Button x:Name="downButton" Grid.Column="1" Grid.Row="1" Content="v"/>
+ <TextBox x:Name="input" Grid.RowSpan="2" />
+ </Grid>
+</UserControl>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open System
+open System.Windows
+open System.Windows.Data
+open System.Windows.Input
+
+open FsXaml
+
+type NumericUpDown = XAML<"XAML/NumericUpDown.xaml", true>
+
+type NumericUpDownEvents = Up | Down
+
+type NumericUpDownController() =
+ inherit UserControlViewController<NumericUpDown>()
+
+
--- /dev/null
+<UserControl
+ xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+ xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+ xmlns:d="http://schemas.microsoft.com/expression/blend/2008"
+ xmlns:fsxaml="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
+ xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"
+ mc:Ignorable="d" d:DesignWidth="100" d:DesignHeight="100"
+ >
+ <Grid x:Name="grid">
+ <Grid.ContextMenu>
+ <ContextMenu>
+ <MenuItem x:Name="menuRBCSetAsHealthy" Header="_Set as healthy" />
+ <MenuItem x:Name="menuRBCSetAsInfected" Header="_Set as infected" />
+ </ContextMenu>
+ </Grid.ContextMenu>
+ <Rectangle x:Name="border" Fill="#00000000" />
+ <Polygon x:Name="manuallyAdded" Points="0,0 12,0, 12,12" Fill="Black" HorizontalAlignment="Right" VerticalAlignment="Top" />
+ <Border HorizontalAlignment="Right" VerticalAlignment="Bottom" Margin="0,0,3,3" Background="#66000000" CornerRadius="5">
+ <TextBlock x:Name="txtRBCNumber" Padding="2" Text="42" Foreground="White" />
+ </Border>
+ </Grid>
+</UserControl>
\ No newline at end of file
--- /dev/null
+namespace ParasitemiaUI.Views
+
+open System
+open System.Windows
+open System.Windows.Data
+open System.Windows.Input
+
+open FSharp.ViewModule
+open FsXaml
+
+type RBCFrame = XAML<"XAML/RBCFrame.xaml", true>
--- /dev/null
+<?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" />
+</packages>
\ No newline at end of file
--- /dev/null
+1 ICON "resources\icon.ico"
\ No newline at end of file
projects / master-thesis.git / commitdiff