diff --git a/src/Informedica.GenForm.Lib/Scripts/Update.fsx b/src/Informedica.GenForm.Lib/Scripts/Update.fsx index d85b66e..d81075b 100644 --- a/src/Informedica.GenForm.Lib/Scripts/Update.fsx +++ b/src/Informedica.GenForm.Lib/Scripts/Update.fsx @@ -386,4 +386,249 @@ module Types = Patient : Patient DoseRule : DoseRule SolutionRules : SolutionRule [] - } \ No newline at end of file + } + + +[] +module Utils = + + open System + open System.IO + open System.Net.Http + + open Informedica.Utils.Lib + open Informedica.Utils.Lib.BCL + + + + module Web = + + + /// The url to the data sheet for Constraints + let [] dataUrlIdConstraints = "1nny8rn9zWtP8TMawB3WeNWhl5d4ofbWKbGzGqKTd49g" + + + /// The url to the data sheet for GenPRES + /// https://docs.google.com/spreadsheets/d/1AEVYnqjAbVniu3VuczeoYvMu3RRBu930INhr3QzSDYQ/edit?usp=sharing + let [] dataUrlIdGenPres = "1AEVYnqjAbVniu3VuczeoYvMu3RRBu930INhr3QzSDYQ" + + + /// + /// Get data from a web sheet + /// + /// The Url Id of the web sheet + /// The specific sheet + /// The data as a table of string array array + let getDataFromSheet urlId sheet = + fun () -> Web.GoogleSheets.getDataFromSheet urlId sheet + |> StopWatch.clockFunc $"loaded {sheet} from web sheet" + + + + module BigRational = + + + /// + /// Parse an array of strings in float format to an array of BigRational + /// + /// + /// Uses ; as separator. Filters out non parsable strings. + /// + /// + /// + /// let brs = toBrs "1.0;2.0;3.0" + /// // returns [|1N; 2N; 3N|] + /// let brs = toBrs "1.0;2.0;3.0;abc" + /// // returns [|1N; 2N; 3N|] + /// + /// + let toBrs s = + s + |> String.splitAt ';' + |> Array.choose Double.tryParse + |> Array.choose BigRational.fromFloat + + + /// + /// Return 2 BigRational arrays as a tuple of optional first BigRational + /// of the first and second array. A None is returned for an empty array. + /// + /// + /// + /// let brs1 = [|1N|] + /// let brs2 = [|4N|] + /// tupleBrOpt brs1 brs2 + /// // returns (Some 1N, Some 4N) + /// let brs1 = [|1N|] + /// let brs2 = [||] + /// tupleBrOpt brs1 brs2 + /// // returns (Some 1N, None) + /// + /// + let tupleBrOpt brs1 brs2 = + brs1 |> Array.tryHead, + brs2 |> Array.tryHead + + + + +module Mapping = + + open Informedica.Utils.Lib + open Informedica.Utils.Lib.BCL + open Informedica.GenUnits.Lib + + + /// Mapping of long Z-index route names to short names + let routeMapping = + Web.getDataFromSheet Web.dataUrlIdGenPres "Routes" + |> fun data -> + let getColumn = + data + |> Array.head + |> Csv.getStringColumn + + data + |> Array.tail + |> Array.map (fun r -> + let get = getColumn r + + {| + Long = get "ZIndex" + Short = get "ShortDutch" + |} + ) + + + /// Mapping of long Z-index unit names to short names + let unitMapping = + Web.getDataFromSheet Web.dataUrlIdGenPres "Units" + |> fun data -> + let getColumn = + data + |> Array.head + |> Csv.getStringColumn + + data + |> Array.tail + |> Array.map (fun r -> + let get = getColumn r + + {| + Long = get "ZIndexUnitLong" + Short = get "Unit" + MV = get "MetaVisionUnit" + |} + ) + + + /// Try to find mapping for a route + let mapRoute rte = + routeMapping + |> Array.tryFind (fun r -> + r.Long |> String.equalsCapInsens rte || + r.Short |> String.equalsCapInsens rte + + ) + |> Option.map (fun r -> r.Short) + + + /// Try to map a unit to a short name + let mapUnit unt = + unitMapping + |> Array.tryFind (fun r -> + r.Long |> String.equalsCapInsens unt || + r.Short |> String.equalsCapInsens unt + ) + |> Option.map (fun r -> r.Short) + + + /// Get the array of RouteShape records + let mappingRouteShape = + Web.getDataFromSheet Web.dataUrlIdGenPres "ShapeRoute" + |> fun data -> + let inline getColumn get = + data + |> Array.head + |> get + + data + |> Array.tail + |> Array.map (fun r -> + let getStr = getColumn Csv.getStringColumn r + let getFlt = getColumn Csv.getFloatOptionColumn r + + { + Route = getStr "Route" + Shape = getStr "Shape" + Unit = getStr "Unit" |> Units.fromString |> Option.defaultValue NoUnit + DoseUnit = getStr "DoseUnit" |> Units.fromString |> Option.defaultValue NoUnit + MinDoseQty = None // getFlt "MinDoseQty" + MaxDoseQty = None //getFlt "MaxDoseQty" + Timed = getStr "Timed" |> String.equalsCapInsens "true" + Reconstitute = getStr "Reconstitute" |> String.equalsCapInsens "true" + IsSolution = getStr "IsSolution" |> String.equalsCapInsens "true" + } + |> fun rs -> + match rs.DoseUnit with + | NoUnit -> rs + | du -> + { rs with + MinDoseQty = + getFlt "MinDoseQty" + |> Option.bind (fun v -> + v + |> BigRational.fromFloat + |> Option.map (ValueUnit.singleWithUnit du) + ) + MaxDoseQty = + getFlt "MaxDoseQty" + |> Option.bind (fun v -> + v + |> BigRational.fromFloat + |> Option.map (ValueUnit.singleWithUnit du) + ) + } + ) + + + /// + /// Filter the mappingRouteShape array on route, shape and unit + /// + /// The Route + /// The Shape + /// The Unit + /// An array of RouteShape records + let filterRouteShapeUnit rte shape unt = + mappingRouteShape + |> Array.filter (fun xs -> + let eqsRte = + rte |> String.isNullOrWhiteSpace || + rte |> String.trim |> String.equalsCapInsens xs.Route || + xs.Route |> mapRoute |> Option.map (String.equalsCapInsens (rte |> String.trim)) |> Option.defaultValue false + let eqsShp = shape |> String.isNullOrWhiteSpace || shape |> String.trim |> String.equalsCapInsens xs.Shape + let eqsUnt = + unt = NoUnit || + unt = xs.Unit + eqsRte && eqsShp && eqsUnt + ) + + (* + + let private requires_ (rtes, unt, shape) = + rtes + |> Array.collect (fun rte -> + filterRouteShapeUnit rte shape unt + ) + |> Array.map (fun xs -> xs.Reconstitute) + |> Array.exists id + + + /// Check if reconstitution is required for a route, shape and unit + let requiresReconstitution = + Memoization.memoize requires_ + + *) + + +Mapping.mappingRouteShape[9] \ No newline at end of file diff --git a/src/Informedica.GenUnits.Lib/ValueUnit.fs b/src/Informedica.GenUnits.Lib/ValueUnit.fs index 461ac66..c149a56 100644 --- a/src/Informedica.GenUnits.Lib/ValueUnit.fs +++ b/src/Informedica.GenUnits.Lib/ValueUnit.fs @@ -155,7 +155,7 @@ module Parser = /// let setUnitValue u v = u - |> ValueUnit.apply (fun _ -> v) + |> apply (fun _ -> v) /// @@ -1562,35 +1562,6 @@ module Units = -module ValueUnit = - - - //---------------------------------------------------------------------------- - // Operator String functions - //---------------------------------------------------------------------------- - - - /// Transforms an operator to a string - let opToStr op = - match op with - | OpPer -> "/" - | OpTimes -> "*" - | OpPlus -> "+" - | OpMinus -> "-" - - - /// Transforms an operator to a string - /// (*, /, +, -), throws an error if - /// no match - let opFromString s = - match s with - | _ when s = "/" -> OpPer - | _ when s = "*" -> OpPer - | _ when s = "+" -> OpPer - | _ when s = "-" -> OpPer - | _ -> failwith <| $"Cannot parse %s{s} to operand" - - //---------------------------------------------------------------------------- // Apply and Map //---------------------------------------------------------------------------- @@ -1756,6 +1727,36 @@ module ValueUnit = app u + +module ValueUnit = + + + //---------------------------------------------------------------------------- + // Operator String functions + //---------------------------------------------------------------------------- + + + /// Transforms an operator to a string + let opToStr op = + match op with + | OpPer -> "/" + | OpTimes -> "*" + | OpPlus -> "+" + | OpMinus -> "-" + + + /// Transforms an operator to a string + /// (*, /, +, -), throws an error if + /// no match + let opFromString s = + match s with + | _ when s = "/" -> OpPer + | _ when s = "*" -> OpPer + | _ when s = "+" -> OpPer + | _ when s = "-" -> OpPer + | _ -> failwith <| $"Cannot parse %s{s} to operand" + + module Group = /// Get the corresponding group for a unit @@ -2244,18 +2245,18 @@ module ValueUnit = // this is not enough when u2 is combiunit but // contains u1! | _ when u1 |> Group.eqsGroup u2 -> - let n1 = (u1 |> getUnitValue) - let n2 = (u2 |> getUnitValue) + let n1 = (u1 |> Units.getUnitValue) + let n2 = (u2 |> Units.getUnitValue) match n1, n2 with - | Some x1, Some x2 -> count |> setUnitValue (x1 / x2) + | Some x1, Some x2 -> count |> Units.setUnitValue (x1 / x2) | _ -> count | _ when u2 |> Group.eqsGroup count -> - let n1 = u1 |> getUnitValue - let n2 = u2 |> getUnitValue + let n1 = u1 |> Units.getUnitValue + let n2 = u2 |> Units.getUnitValue match n1, n2 with - | Some x1, Some x2 -> u1 |> setUnitValue (x1 / x2) + | Some x1, Some x2 -> u1 |> Units.setUnitValue (x1 / x2) | _ -> u1 | _ -> (u1, OpPer, u2) |> CombiUnit | OpTimes -> @@ -2266,25 +2267,25 @@ module ValueUnit = u1 |> Group.eqsGroup count && u2 |> Group.eqsGroup count -> - let n1 = u1 |> getUnitValue - let n2 = u2 |> getUnitValue + let n1 = u1 |> Units.getUnitValue + let n2 = u2 |> Units.getUnitValue match n1, n2 with - | Some x1, Some x2 -> u1 |> setUnitValue (x1 * x2) + | Some x1, Some x2 -> u1 |> Units.setUnitValue (x1 * x2) | _ -> u1 | _ when u1 |> Group.eqsGroup count -> - let n1 = u1 |> getUnitValue - let n2 = u2 |> getUnitValue + let n1 = u1 |> Units.getUnitValue + let n2 = u2 |> Units.getUnitValue match n1, n2 with - | Some x1, Some x2 -> u2 |> setUnitValue (x1 * x2) + | Some x1, Some x2 -> u2 |> Units.setUnitValue (x1 * x2) | _ -> u2 | _ when u2 |> Group.eqsGroup count -> - let n1 = u1 |> getUnitValue - let n2 = u2 |> getUnitValue + let n1 = u1 |> Units.getUnitValue + let n2 = u2 |> Units.getUnitValue match n1, n2 with - | Some x1, Some x2 -> u1 |> setUnitValue (x1 * x2) + | Some x1, Some x2 -> u1 |> Units.setUnitValue (x1 * x2) | _ -> u1 | _ -> // In physics, multiplying quantities with different units, like mass and volume, @@ -2308,11 +2309,11 @@ module ValueUnit = | ZeroUnit, u | u, ZeroUnit -> u | _ when u1 |> Group.eqsGroup u2 -> - let n1 = u1 |> getUnitValue - let n2 = u2 |> getUnitValue + let n1 = u1 |> Units.getUnitValue + let n2 = u2 |> Units.getUnitValue match n1, n2 with - | Some x1, Some x2 -> u1 |> setUnitValue (x1 + x2) + | Some x1, Some x2 -> u1 |> Units.setUnitValue (x1 + x2) | _ -> u1 | _ -> failwith <| $"Cannot combine units {u1} and {u2} with operator {op}"