Commit 85b9a22e authored by Louis Duchemin's avatar Louis Duchemin
Browse files

Stronger typing for Gemma.Result_file

parent 95106304
......@@ -38,6 +38,7 @@ let write_genotypes ~alignment ~output =
| Error _ -> failwithf "could not open %s" alignment ())
module Result_file = struct
(* invariant : at least one pval is not none *)
type item = {
index : int;
residue : char;
......@@ -46,33 +47,58 @@ module Result_file = struct
pval_wald : float option;
}
let maybe_binop ~f x y =
match (x, y) with
| None, None -> None
| Some _, None -> x
| None, _ -> y
| Some x, Some y -> Some (f x y)
let min_pval_of_item it =
let f = maybe_binop ~f:Float.min in
None |> f it.pval_lrt |> f it.pval_wald |> f it.pval_score
|> Option.value_exn
(* because of item invariant *)
type t = item list
type pval_decoder = {
lrt : int option;
wald : int option;
score : int option;
}
module Pval_decoder : sig
type t
let index_of_column header colname =
List.findi header ~f:(fun _ -> String.equal colname) |> Option.map ~f:fst
let pval_decoder_of_header header =
{
lrt = index_of_column header "p_lrt";
wald = index_of_column header "p_wald";
score = index_of_column header "p_score";
}
let pval_parser_max_field pvp =
let f x y =
match (x, y) with
| None, None -> None
| Some _, None -> x
| None, _ -> y
| Some x, Some y -> Some (Int.max x y)
in
None |> f pvp.lrt |> f pvp.wald |> f pvp.score
val of_header : string list -> (t, string) result
val max_field : t -> int option
val lrt_field : t -> int option
val score_field : t -> int option
val wald_field : t -> int option
end = struct
type t = { lrt : int option; wald : int option; score : int option }
let lrt_field x = x.lrt
let wald_field x = x.wald
let score_field x = x.score
let index_of_column header colname =
List.findi header ~f:(fun _ -> String.equal colname) |> Option.map ~f:fst
let of_header header =
let lrt = index_of_column header "p_lrt" in
let wald = index_of_column header "p_wald" in
let score = index_of_column header "p_score" in
match (lrt, wald, score) with
| None, None, None -> Error "invalid header: no pvalue field"
| _ -> Ok { lrt; wald; score }
let max_field pvp =
let f = maybe_binop ~f:Int.max in
None |> f pvp.lrt |> f pvp.wald |> f pvp.score
end
let parse_locus_id locus_id =
match String.split ~on:'_' locus_id with
......@@ -86,23 +112,29 @@ module Result_file = struct
in
if
Array.length fields
< fields_upper_bound 2 (pval_parser_max_field pval_parser)
< fields_upper_bound 2 (Pval_decoder.max_field pval_parser)
then failwith "parse_line: not enough fields";
let index, residue = parse_locus_id fields.(1) in
let get_pval = Option.map ~f:(fun i -> fields.(i) |> Float.of_string) in
let pval_wald = get_pval pval_parser.wald in
let pval_score = get_pval pval_parser.score in
let pval_lrt = get_pval pval_parser.lrt in
let get_pval f =
Option.map (f pval_parser) ~f:(fun i -> fields.(i) |> Float.of_string)
in
let pval_wald = get_pval Pval_decoder.wald_field in
let pval_score = get_pval Pval_decoder.score_field in
let pval_lrt = get_pval Pval_decoder.lrt_field in
{ index; residue; pval_lrt; pval_score; pval_wald }
let parse_header = function
| [] -> Error "Result file is empty"
| header :: lines -> Ok (header, lines)
let of_file filename =
match
let open Result.Monad_infix in
let lines =
In_channel.read_lines filename |> List.map ~f:(String.split ~on:'\t')
with
| [] -> failwith "Result file is empty"
| header :: lines ->
let pvp = pval_decoder_of_header header in
List.map lines ~f:(parse_line pvp)
in
parse_header lines >>= fun (header, lines) ->
Pval_decoder.of_header header >>| fun pvp ->
List.map lines ~f:(parse_line pvp)
let to_result_table results ~site_aggregator =
let scores =
......
......@@ -5,7 +5,7 @@ val write_phenotypes : newick:string -> output:string -> unit
val write_genotypes : alignment:string -> output:string -> unit
module Result_file : sig
type item = {
type item = private {
index : int;
residue : char;
pval_lrt : float option;
......@@ -13,9 +13,11 @@ module Result_file : sig
pval_wald : float option;
}
val min_pval_of_item : item -> float
type t = item list
val of_file : string -> t
val of_file : string -> (t, string) result
val to_result_table :
t -> site_aggregator:(item List1.t -> float) -> Result_table.t
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment