X-Git-Url: http://git.euphorik.ch/?p=master-thesis.git;a=blobdiff_plain;f=Parasitemia%2FParasitemiaCore%2FAnalysis.fs;h=8b16c458952621cb7cf2910b0431216f0bd5285f;hp=c894fc4440b93a196f320686d3a5f7d9647b648d;hb=2d712781def419c9acc98368f7102b19b064f16d;hpb=18a450dd9264befbe5d3c1e611d52c2ac53079e4 diff --git a/Parasitemia/ParasitemiaCore/Analysis.fs b/Parasitemia/ParasitemiaCore/Analysis.fs index c894fc4..8b16c45 100644 --- a/Parasitemia/ParasitemiaCore/Analysis.fs +++ b/Parasitemia/ParasitemiaCore/Analysis.fs @@ -27,39 +27,37 @@ open Types /// The first call returning 'false' will cancel the analysis. /// The 'int' parameter correspond to the progression from 0 to 100 /// A list of detected cells or nothing if the process has been cancelled -let doAnalysis (img: Image) (name: string) (config: Config) (reportProgress: (int -> bool) option) : Cell list option = +let doAnalysis (img : Image) (name : string) (config : Config) (reportProgress : (int -> bool) option) : Cell list option = // To report the progress of this function from 0 to 100. // Return 'None' if the process must be aborted. - let reportWithVal (percent: int) (value: 'a) : 'a option = + let reportWithVal (percent : int) (value : 'a) : 'a option = match reportProgress with - | Some f -> - if f percent - then Some value - else None + | Some f -> if f percent then Some value else None | _ -> Some value - let report (percent: int) : unit option = + let report (percent : int) : unit option = reportWithVal percent () - let inline buildLogWithName (text: string) = sprintf "№ %s: %s" name text - let logWithName mess = Log.User(buildLogWithName mess) - let inline logTimeWithName (text: string) (f: unit -> 'a option) : 'a option = Log.LogWithTime((buildLogWithName text), Severity.USER, f) + let inline buildLogWithName (text : string) = sprintf "№ %s: %s" name text + let logWithName mess = Log.Info "%s" (buildLogWithName mess) + let inline logTimeWithName (text : string) (f : unit -> 'a option) : 'a option = Log.LogWithTime Severity.INFO f "%s" (buildLogWithName text) + // Monadic construction to be able to abort the progress when running. maybe { do! report 0 logWithName "Starting analysis ..." - use img_float = img.Convert() + use img_float = img.Convert () - use img_RBC = img_float.[1] // mergeChannelsWithProjection img_float config.Parameters.averageColor_RBC config.Parameters.averageColor_BG 255. + use img_RBC = img_float.[1] // Green. use img_RBC_filtered = gaussianFilter img_RBC config.LPFStandardDeviationRBC - use img_parasites = img_float.[2] // mergeChannelsWithProjection img_float config.Parameters.averageColor_Parasite config.Parameters.averageColor_RBC 255. + use img_parasites = img_float.[2] // Red. use img_parasites_filtered = gaussianFilter img_parasites config.LPFStandardDeviationParasite - logWithName (sprintf "Nominal erythrocyte diameter: %A" config.RBCRadiusByResolution) + logWithName (sprintf "Nominal erythrocyte diameter: %O" config.RBCRadiusByResolution) let initialAreaOpening = int <| config.RBCRadiusByResolution.Area * config.Parameters.ratioAreaPaleCenter * 1.1f // We do an area opening a little larger to avoid to do a second one in the case the radius found is near the initial one. do! logTimeWithName "First area opening" (fun () -> areaOpenF img_RBC_filtered initialAreaOpening; report 10) @@ -68,18 +66,17 @@ let doAnalysis (img: Image) (name: string) (config: Config) (reportPr let delta = config.Parameters.granulometryRange * config.RBCRadiusByResolution.Pixel int <| config.RBCRadiusByResolution.Pixel - delta, int <| config.RBCRadiusByResolution.Pixel + delta - let! radius = logTimeWithName "Granulometry (area)" (fun() -> reportWithVal 10 (Granulometry.findRadiusByAreaClosing img_RBC_filtered range |> float32)) - //let! radius = logTimeWithName "Granulometry (morpho)" (fun() -> reportWithVal 10 (Granulometry.findRadiusByClosing img_RBC_filtered range 1. true |> float32)) + let! radius = logTimeWithName "Granulometry (area)" (fun () -> reportWithVal 10 (Granulometry.findRadiusByAreaClosing img_RBC_filtered range |> float32)) + //let! radius = logTimeWithName "Granulometry (morpho)" (fun () -> reportWithVal 10 (Granulometry.findRadiusByClosing img_RBC_filtered range 1. true |> float32)) config.SetRBCRadius <| radius - logWithName (sprintf "Found erythrocyte diameter: %A" config.RBCRadius) + logWithName (sprintf "Found erythrocyte diameter: %O" config.RBCRadius) do! report 20 do! let secondAreaOpening = int <| config.RBCRadius.Area * config.Parameters.ratioAreaPaleCenter - if secondAreaOpening > initialAreaOpening - then + if secondAreaOpening > initialAreaOpening then logTimeWithName "Second area opening" (fun () -> areaOpenF img_RBC_filtered secondAreaOpening; report 30) else report 30 @@ -93,16 +90,19 @@ let doAnalysis (img: Image) (name: string) (config: Config) (reportPr let! parasites, imgWhitoutParasite, imgWithoutNucleus = logTimeWithName "Parasites segmentation" (fun () -> reportWithVal 40 (ParasitesMarker.find img_parasites_filtered config)) - let! edges, xGradient, yGradient = logTimeWithName "Finding edges" (fun () -> - let edges, xGradient, yGradient = Edges.find img_RBC_filtered - removeArea edges (config.RBCRadius.Pixel ** 2.f / 50.f |> int) - reportWithVal 50 (edges, xGradient, yGradient)) + let! edges, xGradient, yGradient = + logTimeWithName "Finding edges" ( + fun () -> + let edges, xGradient, yGradient = Edges.find img_RBC_filtered + removeArea edges (config.RBCRadius.Pixel ** 2.f / 50.f |> int) + reportWithVal 50 (edges, xGradient, yGradient) + ) let! matchingEllipses = logTimeWithName "Finding ellipses" (fun () -> reportWithVal 60 (Ellipse.find edges xGradient yGradient config)) let! prunedEllipses = logTimeWithName "Ellipses pruning" (fun () -> reportWithVal 80 (matchingEllipses.PrunedEllipses)) - let! cells = logTimeWithName "Classifier" (fun () -> reportWithVal 100 (Classifier.findCells prunedEllipses parasites img_RBC_filtered config)) + let! cells = logTimeWithName "Classifier" (fun () -> reportWithVal 100 (Classifier.findCells prunedEllipses parasites img.Width img.Height config)) logWithName "Analysis finished" @@ -110,10 +110,10 @@ let doAnalysis (img: Image) (name: string) (config: Config) (reportPr // Output pictures if debug flag is set. match config.Debug with | DebugOn output -> - let dirPath = System.IO.Path.Combine(output, name) + let dirPath = System.IO.Path.Combine (output, name) System.IO.Directory.CreateDirectory dirPath |> ignore - let buildFileName postfix = System.IO.Path.Combine(dirPath, name + postfix) + let buildFileName postfix = System.IO.Path.Combine (dirPath, name + postfix) IO.saveMat (edges * 255.0) (buildFileName " - edges.png") @@ -121,26 +121,26 @@ let doAnalysis (img: Image) (name: string) (config: Config) (reportPr IO.saveImg parasites.parasite (buildFileName " - parasites - stain.png") IO.saveImg parasites.nucleus (buildFileName " - parasites - infection.png") - let imgAllEllipses = img_RBC_filtered.Copy() - Drawing.drawEllipses imgAllEllipses matchingEllipses.Ellipses (Gray(200.0)) 0.04 + let imgAllEllipses = img_RBC_filtered.Copy () + Drawing.drawEllipses imgAllEllipses matchingEllipses.Ellipses (Gray 200.0) 0.04 IO.saveImg imgAllEllipses (buildFileName " - ellipses - all.png") - let imgEllipses = img_RBC_filtered.Convert() - Drawing.drawEllipses imgEllipses prunedEllipses (Bgr(0.0, 240.0, 240.0)) 1.0 + let imgEllipses = img_RBC_filtered.Convert () + Drawing.drawEllipses imgEllipses prunedEllipses (Bgr (0.0, 240.0, 240.0)) 1.0 IO.saveImg imgEllipses (buildFileName " - ellipses.png") - let imgCells = img.Copy() + let imgCells = img.Copy () Drawing.drawCells imgCells false cells IO.saveImg imgCells (buildFileName " - cells.png") - let imgCells' = img.Copy() + let imgCells' = img.Copy () Drawing.drawCells imgCells' true cells IO.saveImg imgCells' (buildFileName " - cells - full.png") - let filteredGreenMaxima = gaussianFilter img_RBC config.LPFStandardDeviationRBC - for m in findMaxima filteredGreenMaxima do - Drawing.drawPoints filteredGreenMaxima m 255.f - IO.saveImg filteredGreenMaxima (buildFileName " - filtered - maxima.png") + (* let filteredRBCMaxima = gaussianFilter img_RBC config.LPFStandardDeviationRBC + for m in findMaxima filteredRBCMaxima do + Drawing.drawPoints filteredRBCMaxima m 255.f + IO.saveImg filteredRBCMaxima (buildFileName " - filtered - maxima.png") *) IO.saveImg imgWhitoutParasite (buildFileName " - filtered closed stain.png") IO.saveImg imgWithoutNucleus (buildFileName " - filtered closed infection.png") @@ -148,12 +148,13 @@ let doAnalysis (img: Image) (name: string) (config: Config) (reportPr IO.saveImg img_RBC_filtered (buildFileName " - source - RBC.png") IO.saveImg img_parasites_filtered (buildFileName " - source - parasites.png") - IO.saveImg (normalize img_float.[2] 255.) (buildFileName " - source - red.png") - IO.saveImg (normalize img_float.[1] 255.) (buildFileName " - source - green.png") - IO.saveImg (normalize img_float.[0] 255.) (buildFileName " - source - blue.png") + IO.saveImg img_float.[2] (buildFileName " - source - red.png") + IO.saveImg img_float.[1] (buildFileName " - source - green.png") + IO.saveImg img_float.[0] (buildFileName " - source - blue.png") | _ -> () - return cells } + return cells + } /// /// Do multiple analyses on the same time. The number of concurrent process depends if the number of the core. @@ -163,18 +164,18 @@ let doAnalysis (img: Image) (name: string) (config: Config) (reportPr /// The first call returning 'false' will cancel the analysis. /// The 'int' parameter correspond to the progression from 0 to 100 /// 'None' if the process has been cancelled or the list of result as (name * cells), 'name' corresponds to the given name -let doMultipleAnalysis (imgs: (string * Config * Image) list) (reportProgress: (int -> bool) option) : (string * Cell list) list option = - let report (percent: int) : bool = +let doMultipleAnalysis (imgs : (string * Config * Image) list) (reportProgress : (int -> bool) option) : (string * Cell list) list option = + let report (percent : int) : bool = match reportProgress with | Some f -> f percent | _ -> true - let progressPerAnalysis = System.Collections.Concurrent.ConcurrentDictionary() + let progressPerAnalysis = System.Collections.Concurrent.ConcurrentDictionary () let nbImgs = List.length imgs - let reportProgressImg (id: string) (progress: int) = - progressPerAnalysis.AddOrUpdate(id, progress, (fun _ _ -> progress)) |> ignore - report (progressPerAnalysis.Values.Sum() / nbImgs) + let reportProgressImg (id : string) (progress : int) = + progressPerAnalysis.AddOrUpdate (id, progress, (fun _ _ -> progress)) |> ignore + report (progressPerAnalysis.Values.Sum () / nbImgs) let n = Environment.ProcessorCount @@ -182,14 +183,21 @@ let doMultipleAnalysis (imgs: (string * Config * Image) list) (report imgs |> PSeq.choose ( fun (id, config, img) -> - match doAnalysis img id config (Some (fun p -> reportProgressImg id p)) with - | Some result -> Some (id, result) - | None -> None) + try + match doAnalysis img id config (Some (fun p -> reportProgressImg id p)) with + | Some result -> Some (id, result) + | None -> None + with + | ex -> + Log.Error "Analysis %s failed: %O" id ex + None + ) |> PSeq.withDegreeOfParallelism n |> PSeq.toList // If one of the analyses has been aborted we return 'None'. - if List.length results <> List.length imgs - then None - else Some results + if List.length results <> List.length imgs then + None + else + Some results