Add a logger assembly and split the main assembly in two : the UI and the parasitemia...
authorGreg Burri <greg.burri@gmail.com>
Mon, 18 Jan 2016 12:22:20 +0000 (13:22 +0100)
committerGreg Burri <greg.burri@gmail.com>
Mon, 18 Jan 2016 12:22:20 +0000 (13:22 +0100)
97 files changed:
Parasitemia/Logger/AssemblyInfo.fs [new file with mode: 0644]
Parasitemia/Logger/Logger.fs [new file with mode: 0644]
Parasitemia/Logger/Logger.fsproj [new file with mode: 0644]
Parasitemia/Parasitemia.sln
Parasitemia/Parasitemia/App.config [deleted file]
Parasitemia/Parasitemia/AssemblyInfo.fs [deleted file]
Parasitemia/Parasitemia/Classifier.fs [deleted file]
Parasitemia/Parasitemia/Config.fs [deleted file]
Parasitemia/Parasitemia/Const.fs [deleted file]
Parasitemia/Parasitemia/EEOver.fs [deleted file]
Parasitemia/Parasitemia/Ellipse.fs [deleted file]
Parasitemia/Parasitemia/GUI/About.fs [deleted file]
Parasitemia/Parasitemia/GUI/AboutWindow.xaml [deleted file]
Parasitemia/Parasitemia/GUI/AboutWindow.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/Analysis.fs [deleted file]
Parasitemia/Parasitemia/GUI/AnalysisWindow.xaml [deleted file]
Parasitemia/Parasitemia/GUI/AnalysisWindow.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/GUI.fs [deleted file]
Parasitemia/Parasitemia/GUI/ImageSourcePreview.xaml [deleted file]
Parasitemia/Parasitemia/GUI/ImageSourcePreview.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/ImageSourceSelection.xaml [deleted file]
Parasitemia/Parasitemia/GUI/ImageSourceSelection.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/MainWindow.xaml [deleted file]
Parasitemia/Parasitemia/GUI/MainWindow.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/NumericUpDown.xaml [deleted file]
Parasitemia/Parasitemia/GUI/NumericUpDown.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/PiaZ.fs [deleted file]
Parasitemia/Parasitemia/GUI/RBCFrame.xaml [deleted file]
Parasitemia/Parasitemia/GUI/RBCFrame.xaml.fs [deleted file]
Parasitemia/Parasitemia/GUI/State.fs [deleted file]
Parasitemia/Parasitemia/GUI/Types.fs [deleted file]
Parasitemia/Parasitemia/Granulometry.fs [deleted file]
Parasitemia/Parasitemia/Heap.fs [deleted file]
Parasitemia/Parasitemia/ImgTools.fs [deleted file]
Parasitemia/Parasitemia/KMeans.fs [deleted file]
Parasitemia/Parasitemia/KMedians.fs [deleted file]
Parasitemia/Parasitemia/KdTree.fs [deleted file]
Parasitemia/Parasitemia/MainAnalysis.fs [deleted file]
Parasitemia/Parasitemia/MatchingEllipses.fs [deleted file]
Parasitemia/Parasitemia/Parasitemia.fsproj [deleted file]
Parasitemia/Parasitemia/ParasitesMarker.fs [deleted file]
Parasitemia/Parasitemia/Program.fs [deleted file]
Parasitemia/Parasitemia/Resources/icon.ico [deleted file]
Parasitemia/Parasitemia/Types.fs [deleted file]
Parasitemia/Parasitemia/UnitsOfMeasure.fs [deleted file]
Parasitemia/Parasitemia/Utils.fs [deleted file]
Parasitemia/Parasitemia/packages.config [deleted file]
Parasitemia/Parasitemia/resources.rc [deleted file]
Parasitemia/Parasitemia/resources.res [deleted file]
Parasitemia/ParasitemiaCore/AssemblyInfo.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Classifier.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Config.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Const.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/EEOver.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Ellipse.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Granulometry.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Heap.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/ImgTools.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/KMeans.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/KMedians.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/KdTree.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/MainAnalysis.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/MatchingEllipses.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/ParasitemiaCore.fsproj [new file with mode: 0644]
Parasitemia/ParasitemiaCore/ParasitesMarker.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Types.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/UnitsOfMeasure.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/Utils.fs [new file with mode: 0644]
Parasitemia/ParasitemiaCore/packages.config [new file with mode: 0644]
Parasitemia/ParasitemiaUI/About.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/Analysis.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/App.config [new file with mode: 0644]
Parasitemia/ParasitemiaUI/AssemblyInfo.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/GUI.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/ParasitemiaUI.fsproj [new file with mode: 0644]
Parasitemia/ParasitemiaUI/PiaZ.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/Program.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/Resources/icon.ico [new file with mode: 0644]
Parasitemia/ParasitemiaUI/State.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/Types.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/AboutWindow.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/AboutWindow.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/AnalysisWindow.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/AnalysisWindow.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/ImageSourcePreview.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/ImageSourcePreview.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/ImageSourceSelection.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/ImageSourceSelection.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/NumericUpDown.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/NumericUpDown.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/RBCFrame.xaml [new file with mode: 0644]
Parasitemia/ParasitemiaUI/XAML/RBCFrame.xaml.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/packages.config [new file with mode: 0644]
Parasitemia/ParasitemiaUI/resources.rc [new file with mode: 0644]
Parasitemia/ParasitemiaUI/resources.res [new file with mode: 0644]

diff --git a/Parasitemia/Logger/AssemblyInfo.fs b/Parasitemia/Logger/AssemblyInfo.fs
new file mode 100644 (file)
index 0000000..c810d05
--- /dev/null
@@ -0,0 +1,41 @@
+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
diff --git a/Parasitemia/Logger/Logger.fs b/Parasitemia/Logger/Logger.fs
new file mode 100644 (file)
index 0000000..552e37d
--- /dev/null
@@ -0,0 +1,168 @@
+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)
+
diff --git a/Parasitemia/Logger/Logger.fsproj b/Parasitemia/Logger/Logger.fsproj
new file mode 100644 (file)
index 0000000..19243e6
--- /dev/null
@@ -0,0 +1,72 @@
+<?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
index ea32a4b..545e796 100644 (file)
@@ -3,10 +3,14 @@ Microsoft Visual Studio Solution File, Format Version 12.00
 # Visual Studio 14
 VisualStudioVersion = 14.0.24720.0
 MinimumVisualStudioVersion = 10.0.40219.1
 # 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
 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
 Global
        GlobalSection(SolutionConfigurationPlatforms) = preSolution
                Debug|Any CPU = Debug|Any CPU
@@ -26,6 +30,18 @@ Global
                {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
                {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
        EndGlobalSection
        GlobalSection(SolutionProperties) = preSolution
                HideSolutionNode = FALSE
diff --git a/Parasitemia/Parasitemia/App.config b/Parasitemia/Parasitemia/App.config
deleted file mode 100644 (file)
index 4be2caf..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-<?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
diff --git a/Parasitemia/Parasitemia/AssemblyInfo.fs b/Parasitemia/Parasitemia/AssemblyInfo.fs
deleted file mode 100644 (file)
index 1027e98..0000000
+++ /dev/null
@@ -1,41 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/Classifier.fs b/Parasitemia/Parasitemia/Classifier.fs
deleted file mode 100644 (file)
index 121a7f5..0000000
+++ /dev/null
@@ -1,200 +0,0 @@
-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 })
diff --git a/Parasitemia/Parasitemia/Config.fs b/Parasitemia/Parasitemia/Config.fs
deleted file mode 100644 (file)
index e7deb61..0000000
+++ /dev/null
@@ -1,121 +0,0 @@
-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
-
diff --git a/Parasitemia/Parasitemia/Const.fs b/Parasitemia/Parasitemia/Const.fs
deleted file mode 100644 (file)
index 304d3a9..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-module Const
-
-let PI = float32 System.Math.PI
\ No newline at end of file
diff --git a/Parasitemia/Parasitemia/EEOver.fs b/Parasitemia/Parasitemia/EEOver.fs
deleted file mode 100644 (file)
index 2bd13b2..0000000
+++ /dev/null
@@ -1,724 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/Ellipse.fs b/Parasitemia/Parasitemia/Ellipse.fs
deleted file mode 100644 (file)
index ac3c041..0000000
+++ /dev/null
@@ -1,350 +0,0 @@
-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
-
diff --git a/Parasitemia/Parasitemia/GUI/About.fs b/Parasitemia/Parasitemia/GUI/About.fs
deleted file mode 100644 (file)
index bc8f3e5..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-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
-
diff --git a/Parasitemia/Parasitemia/GUI/AboutWindow.xaml b/Parasitemia/Parasitemia/GUI/AboutWindow.xaml
deleted file mode 100644 (file)
index 3cb0de4..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/AboutWindow.xaml.fs b/Parasitemia/Parasitemia/GUI/AboutWindow.xaml.fs
deleted file mode 100644 (file)
index 5901226..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-namespace Parasitemia.GUI.Views
-
-open FsXaml
-
-type AboutWindow = XAML<"GUI/AboutWindow.xaml">
-
diff --git a/Parasitemia/Parasitemia/GUI/Analysis.fs b/Parasitemia/Parasitemia/GUI/Analysis.fs
deleted file mode 100644 (file)
index 7d72e72..0000000
+++ /dev/null
@@ -1,136 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/GUI/AnalysisWindow.xaml b/Parasitemia/Parasitemia/GUI/AnalysisWindow.xaml
deleted file mode 100644 (file)
index 599d581..0000000
+++ /dev/null
@@ -1,30 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/AnalysisWindow.xaml.fs b/Parasitemia/Parasitemia/GUI/AnalysisWindow.xaml.fs
deleted file mode 100644 (file)
index 78cc682..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-namespace Parasitemia.GUI.Views
-
-open FsXaml
-
-type AnalysisWindow = XAML<"GUI/AnalysisWindow.xaml">
-
diff --git a/Parasitemia/Parasitemia/GUI/GUI.fs b/Parasitemia/Parasitemia/GUI/GUI.fs
deleted file mode 100644 (file)
index 950afc9..0000000
+++ /dev/null
@@ -1,488 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/GUI/ImageSourcePreview.xaml b/Parasitemia/Parasitemia/GUI/ImageSourcePreview.xaml
deleted file mode 100644 (file)
index ae8f5dd..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/ImageSourcePreview.xaml.fs b/Parasitemia/Parasitemia/GUI/ImageSourcePreview.xaml.fs
deleted file mode 100644 (file)
index 425d436..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-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() *)
diff --git a/Parasitemia/Parasitemia/GUI/ImageSourceSelection.xaml b/Parasitemia/Parasitemia/GUI/ImageSourceSelection.xaml
deleted file mode 100644 (file)
index 62a97f5..0000000
+++ /dev/null
@@ -1,72 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/ImageSourceSelection.xaml.fs b/Parasitemia/Parasitemia/GUI/ImageSourceSelection.xaml.fs
deleted file mode 100644 (file)
index 1ca5c66..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-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() *)
diff --git a/Parasitemia/Parasitemia/GUI/MainWindow.xaml b/Parasitemia/Parasitemia/GUI/MainWindow.xaml
deleted file mode 100644 (file)
index 37ea0c0..0000000
+++ /dev/null
@@ -1,76 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/MainWindow.xaml.fs b/Parasitemia/Parasitemia/GUI/MainWindow.xaml.fs
deleted file mode 100644 (file)
index 4e327e0..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-namespace Parasitemia.GUI.Views
-
-open FsXaml
-
-type MainWindow = XAML<"GUI/MainWindow.xaml">
-
diff --git a/Parasitemia/Parasitemia/GUI/NumericUpDown.xaml b/Parasitemia/Parasitemia/GUI/NumericUpDown.xaml
deleted file mode 100644 (file)
index ae20a5b..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/NumericUpDown.xaml.fs b/Parasitemia/Parasitemia/GUI/NumericUpDown.xaml.fs
deleted file mode 100644 (file)
index 574ffd6..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-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>()
-
-
diff --git a/Parasitemia/Parasitemia/GUI/PiaZ.fs b/Parasitemia/Parasitemia/GUI/PiaZ.fs
deleted file mode 100644 (file)
index d551b8d..0000000
+++ /dev/null
@@ -1,87 +0,0 @@
-// 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
diff --git a/Parasitemia/Parasitemia/GUI/RBCFrame.xaml b/Parasitemia/Parasitemia/GUI/RBCFrame.xaml
deleted file mode 100644 (file)
index 124dc6f..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-<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
diff --git a/Parasitemia/Parasitemia/GUI/RBCFrame.xaml.fs b/Parasitemia/Parasitemia/GUI/RBCFrame.xaml.fs
deleted file mode 100644 (file)
index 1ef4d31..0000000
+++ /dev/null
@@ -1,11 +0,0 @@
-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>
diff --git a/Parasitemia/Parasitemia/GUI/State.fs b/Parasitemia/Parasitemia/GUI/State.fs
deleted file mode 100644 (file)
index 45272ca..0000000
+++ /dev/null
@@ -1,126 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/GUI/Types.fs b/Parasitemia/Parasitemia/GUI/Types.fs
deleted file mode 100644 (file)
index c90fc0c..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/Granulometry.fs b/Parasitemia/Parasitemia/Granulometry.fs
deleted file mode 100644 (file)
index a1c2fd4..0000000
+++ /dev/null
@@ -1,69 +0,0 @@
-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
-
diff --git a/Parasitemia/Parasitemia/Heap.fs b/Parasitemia/Parasitemia/Heap.fs
deleted file mode 100644 (file)
index 3d0879e..0000000
+++ /dev/null
@@ -1,98 +0,0 @@
-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()
-
-
diff --git a/Parasitemia/Parasitemia/ImgTools.fs b/Parasitemia/Parasitemia/ImgTools.fs
deleted file mode 100644 (file)
index 096fd94..0000000
+++ /dev/null
@@ -1,973 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/KMeans.fs b/Parasitemia/Parasitemia/KMeans.fs
deleted file mode 100644 (file)
index 98352fe..0000000
+++ /dev/null
@@ -1,70 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/KMedians.fs b/Parasitemia/Parasitemia/KMedians.fs
deleted file mode 100644 (file)
index d005651..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-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 }
-
-
-
-
diff --git a/Parasitemia/Parasitemia/KdTree.fs b/Parasitemia/Parasitemia/KdTree.fs
deleted file mode 100644 (file)
index 04a1152..0000000
+++ /dev/null
@@ -1,153 +0,0 @@
-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
-
diff --git a/Parasitemia/Parasitemia/MainAnalysis.fs b/Parasitemia/Parasitemia/MainAnalysis.fs
deleted file mode 100644 (file)
index 53429b2..0000000
+++ /dev/null
@@ -1,147 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/MatchingEllipses.fs b/Parasitemia/Parasitemia/MatchingEllipses.fs
deleted file mode 100644 (file)
index 3599bb5..0000000
+++ /dev/null
@@ -1,91 +0,0 @@
-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)
-
diff --git a/Parasitemia/Parasitemia/Parasitemia.fsproj b/Parasitemia/Parasitemia/Parasitemia.fsproj
deleted file mode 100644 (file)
index e20ecb9..0000000
+++ /dev/null
@@ -1,211 +0,0 @@
-<?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
diff --git a/Parasitemia/Parasitemia/ParasitesMarker.fs b/Parasitemia/Parasitemia/ParasitesMarker.fs
deleted file mode 100644 (file)
index 671755c..0000000
+++ /dev/null
@@ -1,86 +0,0 @@
-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
-
-
diff --git a/Parasitemia/Parasitemia/Program.fs b/Parasitemia/Parasitemia/Program.fs
deleted file mode 100644 (file)
index 06059f6..0000000
+++ /dev/null
@@ -1,94 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/Resources/icon.ico b/Parasitemia/Parasitemia/Resources/icon.ico
deleted file mode 100644 (file)
index 147e3a8..0000000
Binary files a/Parasitemia/Parasitemia/Resources/icon.ico and /dev/null differ
diff --git a/Parasitemia/Parasitemia/Types.fs b/Parasitemia/Parasitemia/Types.fs
deleted file mode 100644 (file)
index 5db6bb6..0000000
+++ /dev/null
@@ -1,64 +0,0 @@
-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
-
diff --git a/Parasitemia/Parasitemia/UnitsOfMeasure.fs b/Parasitemia/Parasitemia/UnitsOfMeasure.fs
deleted file mode 100644 (file)
index 6a3b745..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-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
-
-
-
-
-
diff --git a/Parasitemia/Parasitemia/Utils.fs b/Parasitemia/Parasitemia/Utils.fs
deleted file mode 100644 (file)
index 638f9f5..0000000
+++ /dev/null
@@ -1,48 +0,0 @@
-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
diff --git a/Parasitemia/Parasitemia/packages.config b/Parasitemia/Parasitemia/packages.config
deleted file mode 100644 (file)
index 7f36e2b..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
-<?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
diff --git a/Parasitemia/Parasitemia/resources.rc b/Parasitemia/Parasitemia/resources.rc
deleted file mode 100644 (file)
index a9c6f16..0000000
+++ /dev/null
@@ -1 +0,0 @@
-1 ICON "resources\icon.ico"
\ No newline at end of file
diff --git a/Parasitemia/Parasitemia/resources.res b/Parasitemia/Parasitemia/resources.res
deleted file mode 100644 (file)
index 14cf8fa..0000000
Binary files a/Parasitemia/Parasitemia/resources.res and /dev/null differ
diff --git a/Parasitemia/ParasitemiaCore/AssemblyInfo.fs b/Parasitemia/ParasitemiaCore/AssemblyInfo.fs
new file mode 100644 (file)
index 0000000..0925faf
--- /dev/null
@@ -0,0 +1,41 @@
+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
diff --git a/Parasitemia/ParasitemiaCore/Classifier.fs b/Parasitemia/ParasitemiaCore/Classifier.fs
new file mode 100644 (file)
index 0000000..0bea084
--- /dev/null
@@ -0,0 +1,200 @@
+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 })
diff --git a/Parasitemia/ParasitemiaCore/Config.fs b/Parasitemia/ParasitemiaCore/Config.fs
new file mode 100644 (file)
index 0000000..5fdcd0d
--- /dev/null
@@ -0,0 +1,121 @@
+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
+
diff --git a/Parasitemia/ParasitemiaCore/Const.fs b/Parasitemia/ParasitemiaCore/Const.fs
new file mode 100644 (file)
index 0000000..9da7009
--- /dev/null
@@ -0,0 +1,3 @@
+module ParasitemiaCore.Const
+
+let PI = float32 System.Math.PI
\ No newline at end of file
diff --git a/Parasitemia/ParasitemiaCore/EEOver.fs b/Parasitemia/ParasitemiaCore/EEOver.fs
new file mode 100644 (file)
index 0000000..a1358e9
--- /dev/null
@@ -0,0 +1,724 @@
+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
diff --git a/Parasitemia/ParasitemiaCore/Ellipse.fs b/Parasitemia/ParasitemiaCore/Ellipse.fs
new file mode 100644 (file)
index 0000000..520d29d
--- /dev/null
@@ -0,0 +1,350 @@
+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
+
diff --git a/Parasitemia/ParasitemiaCore/Granulometry.fs b/Parasitemia/ParasitemiaCore/Granulometry.fs
new file mode 100644 (file)
index 0000000..ed8bda6
--- /dev/null
@@ -0,0 +1,69 @@
+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
+
diff --git a/Parasitemia/ParasitemiaCore/Heap.fs b/Parasitemia/ParasitemiaCore/Heap.fs
new file mode 100644 (file)
index 0000000..e4230eb
--- /dev/null
@@ -0,0 +1,98 @@
+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()
+
+
diff --git a/Parasitemia/ParasitemiaCore/ImgTools.fs b/Parasitemia/ParasitemiaCore/ImgTools.fs
new file mode 100644 (file)
index 0000000..dd06649
--- /dev/null
@@ -0,0 +1,971 @@
+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
diff --git a/Parasitemia/ParasitemiaCore/KMeans.fs b/Parasitemia/ParasitemiaCore/KMeans.fs
new file mode 100644 (file)
index 0000000..86f1e3b
--- /dev/null
@@ -0,0 +1,70 @@
+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
diff --git a/Parasitemia/ParasitemiaCore/KMedians.fs b/Parasitemia/ParasitemiaCore/KMedians.fs
new file mode 100644 (file)
index 0000000..5819a66
--- /dev/null
@@ -0,0 +1,54 @@
+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 }
+
+
+
+
diff --git a/Parasitemia/ParasitemiaCore/KdTree.fs b/Parasitemia/ParasitemiaCore/KdTree.fs
new file mode 100644 (file)
index 0000000..94a3921
--- /dev/null
@@ -0,0 +1,153 @@
+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
+
diff --git a/Parasitemia/ParasitemiaCore/MainAnalysis.fs b/Parasitemia/ParasitemiaCore/MainAnalysis.fs
new file mode 100644 (file)
index 0000000..846c067
--- /dev/null
@@ -0,0 +1,149 @@
+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
diff --git a/Parasitemia/ParasitemiaCore/MatchingEllipses.fs b/Parasitemia/ParasitemiaCore/MatchingEllipses.fs
new file mode 100644 (file)
index 0000000..b9b4b83
--- /dev/null
@@ -0,0 +1,100 @@
+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)
+
diff --git a/Parasitemia/ParasitemiaCore/ParasitemiaCore.fsproj b/Parasitemia/ParasitemiaCore/ParasitemiaCore.fsproj
new file mode 100644 (file)
index 0000000..1113511
--- /dev/null
@@ -0,0 +1,117 @@
+<?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
diff --git a/Parasitemia/ParasitemiaCore/ParasitesMarker.fs b/Parasitemia/ParasitemiaCore/ParasitesMarker.fs
new file mode 100644 (file)
index 0000000..22ea041
--- /dev/null
@@ -0,0 +1,89 @@
+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
+
+
diff --git a/Parasitemia/ParasitemiaCore/Types.fs b/Parasitemia/ParasitemiaCore/Types.fs
new file mode 100644 (file)
index 0000000..ffe40b5
--- /dev/null
@@ -0,0 +1,64 @@
+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
+
diff --git a/Parasitemia/ParasitemiaCore/UnitsOfMeasure.fs b/Parasitemia/ParasitemiaCore/UnitsOfMeasure.fs
new file mode 100644 (file)
index 0000000..81ce51f
--- /dev/null
@@ -0,0 +1,16 @@
+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
+
+
+
+
+
diff --git a/Parasitemia/ParasitemiaCore/Utils.fs b/Parasitemia/ParasitemiaCore/Utils.fs
new file mode 100644 (file)
index 0000000..bf245aa
--- /dev/null
@@ -0,0 +1,35 @@
+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
diff --git a/Parasitemia/ParasitemiaCore/packages.config b/Parasitemia/ParasitemiaCore/packages.config
new file mode 100644 (file)
index 0000000..4d1f091
--- /dev/null
@@ -0,0 +1,7 @@
+<?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
diff --git a/Parasitemia/ParasitemiaUI/About.fs b/Parasitemia/ParasitemiaUI/About.fs
new file mode 100644 (file)
index 0000000..5f9ce81
--- /dev/null
@@ -0,0 +1,33 @@
+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
+
diff --git a/Parasitemia/ParasitemiaUI/Analysis.fs b/Parasitemia/ParasitemiaUI/Analysis.fs
new file mode 100644 (file)
index 0000000..40fd303
--- /dev/null
@@ -0,0 +1,144 @@
+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)
diff --git a/Parasitemia/ParasitemiaUI/App.config b/Parasitemia/ParasitemiaUI/App.config
new file mode 100644 (file)
index 0000000..4be2caf
--- /dev/null
@@ -0,0 +1,18 @@
+<?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
diff --git a/Parasitemia/ParasitemiaUI/AssemblyInfo.fs b/Parasitemia/ParasitemiaUI/AssemblyInfo.fs
new file mode 100644 (file)
index 0000000..cdeb924
--- /dev/null
@@ -0,0 +1,41 @@
+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
diff --git a/Parasitemia/ParasitemiaUI/GUI.fs b/Parasitemia/ParasitemiaUI/GUI.fs
new file mode 100644 (file)
index 0000000..98b13ea
--- /dev/null
@@ -0,0 +1,503 @@
+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
diff --git a/Parasitemia/ParasitemiaUI/ParasitemiaUI.fsproj b/Parasitemia/ParasitemiaUI/ParasitemiaUI.fsproj
new file mode 100644 (file)
index 0000000..3b88791
--- /dev/null
@@ -0,0 +1,178 @@
+<?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
diff --git a/Parasitemia/ParasitemiaUI/PiaZ.fs b/Parasitemia/ParasitemiaUI/PiaZ.fs
new file mode 100644 (file)
index 0000000..d4ea46f
--- /dev/null
@@ -0,0 +1,97 @@
+// 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
diff --git a/Parasitemia/ParasitemiaUI/Program.fs b/Parasitemia/ParasitemiaUI/Program.fs
new file mode 100644 (file)
index 0000000..bbf20b3
--- /dev/null
@@ -0,0 +1,94 @@
+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
diff --git a/Parasitemia/ParasitemiaUI/Resources/icon.ico b/Parasitemia/ParasitemiaUI/Resources/icon.ico
new file mode 100644 (file)
index 0000000..147e3a8
Binary files /dev/null and b/Parasitemia/ParasitemiaUI/Resources/icon.ico differ
diff --git a/Parasitemia/ParasitemiaUI/State.fs b/Parasitemia/ParasitemiaUI/State.fs
new file mode 100644 (file)
index 0000000..5b89810
--- /dev/null
@@ -0,0 +1,134 @@
+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
diff --git a/Parasitemia/ParasitemiaUI/Types.fs b/Parasitemia/ParasitemiaUI/Types.fs
new file mode 100644 (file)
index 0000000..7d80294
--- /dev/null
@@ -0,0 +1,24 @@
+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
diff --git a/Parasitemia/ParasitemiaUI/XAML/AboutWindow.xaml b/Parasitemia/ParasitemiaUI/XAML/AboutWindow.xaml
new file mode 100644 (file)
index 0000000..3cb0de4
--- /dev/null
@@ -0,0 +1,24 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/AboutWindow.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/AboutWindow.xaml.fs
new file mode 100644 (file)
index 0000000..ed9130d
--- /dev/null
@@ -0,0 +1,6 @@
+namespace ParasitemiaUI.Views
+
+open FsXaml
+
+type AboutWindow = XAML<"XAML/AboutWindow.xaml">
+
diff --git a/Parasitemia/ParasitemiaUI/XAML/AnalysisWindow.xaml b/Parasitemia/ParasitemiaUI/XAML/AnalysisWindow.xaml
new file mode 100644 (file)
index 0000000..599d581
--- /dev/null
@@ -0,0 +1,30 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/AnalysisWindow.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/AnalysisWindow.xaml.fs
new file mode 100644 (file)
index 0000000..07d9573
--- /dev/null
@@ -0,0 +1,6 @@
+namespace ParasitemiaUI.Views
+
+open FsXaml
+
+type AnalysisWindow = XAML<"XAML/AnalysisWindow.xaml">
+
diff --git a/Parasitemia/ParasitemiaUI/XAML/ImageSourcePreview.xaml b/Parasitemia/ParasitemiaUI/XAML/ImageSourcePreview.xaml
new file mode 100644 (file)
index 0000000..ae8f5dd
--- /dev/null
@@ -0,0 +1,23 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/ImageSourcePreview.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/ImageSourcePreview.xaml.fs
new file mode 100644 (file)
index 0000000..6a3a1d5
--- /dev/null
@@ -0,0 +1,17 @@
+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() *)
diff --git a/Parasitemia/ParasitemiaUI/XAML/ImageSourceSelection.xaml b/Parasitemia/ParasitemiaUI/XAML/ImageSourceSelection.xaml
new file mode 100644 (file)
index 0000000..62a97f5
--- /dev/null
@@ -0,0 +1,72 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/ImageSourceSelection.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/ImageSourceSelection.xaml.fs
new file mode 100644 (file)
index 0000000..4c91ed2
--- /dev/null
@@ -0,0 +1,17 @@
+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() *)
diff --git a/Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml b/Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml
new file mode 100644 (file)
index 0000000..37ea0c0
--- /dev/null
@@ -0,0 +1,76 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/MainWindow.xaml.fs
new file mode 100644 (file)
index 0000000..adbfff5
--- /dev/null
@@ -0,0 +1,6 @@
+namespace ParasitemiaUI.Views
+
+open FsXaml
+
+type MainWindow = XAML<"XAML/MainWindow.xaml">
+
diff --git a/Parasitemia/ParasitemiaUI/XAML/NumericUpDown.xaml b/Parasitemia/ParasitemiaUI/XAML/NumericUpDown.xaml
new file mode 100644 (file)
index 0000000..ae20a5b
--- /dev/null
@@ -0,0 +1,21 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/NumericUpDown.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/NumericUpDown.xaml.fs
new file mode 100644 (file)
index 0000000..9f1394d
--- /dev/null
@@ -0,0 +1,17 @@
+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>()
+
+
diff --git a/Parasitemia/ParasitemiaUI/XAML/RBCFrame.xaml b/Parasitemia/ParasitemiaUI/XAML/RBCFrame.xaml
new file mode 100644 (file)
index 0000000..124dc6f
--- /dev/null
@@ -0,0 +1,22 @@
+<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
diff --git a/Parasitemia/ParasitemiaUI/XAML/RBCFrame.xaml.fs b/Parasitemia/ParasitemiaUI/XAML/RBCFrame.xaml.fs
new file mode 100644 (file)
index 0000000..672554b
--- /dev/null
@@ -0,0 +1,11 @@
+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>
diff --git a/Parasitemia/ParasitemiaUI/packages.config b/Parasitemia/ParasitemiaUI/packages.config
new file mode 100644 (file)
index 0000000..1c4cea4
--- /dev/null
@@ -0,0 +1,8 @@
+<?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
diff --git a/Parasitemia/ParasitemiaUI/resources.rc b/Parasitemia/ParasitemiaUI/resources.rc
new file mode 100644 (file)
index 0000000..a9c6f16
--- /dev/null
@@ -0,0 +1 @@
+1 ICON "resources\icon.ico"
\ No newline at end of file
diff --git a/Parasitemia/ParasitemiaUI/resources.res b/Parasitemia/ParasitemiaUI/resources.res
new file mode 100644 (file)
index 0000000..14cf8fa
Binary files /dev/null and b/Parasitemia/ParasitemiaUI/resources.res differ