type approximation = Hoeffding | Relative_Entropy | Exact | Automatic

type tags = 
    Log_hypothesis_size of float
  | Log_prior of float
  | Train_errors of int
  | Test_errors of int
  | Train_examples of int
  | Test_examples of int
  | Approximation of approximation
  | Delta of float
  | Lower_delta of float
  | Error_log_count of int * float
  | Sample_space_log_size of float

type clean_tags = { delta: float; 
		    lower_delta: float; 
		    log_hypothesis_size: float;  
		    log_prior: float;  
		    train_errors: int;  
		    test_errors: int;  
		    train_examples: int;  
		    test_examples:int;
		    approx: approximation;
		    sample_space_log_size: float;
		    error_log_count: float array;
		  }

exception Not_found
exception Error of string

let matches t1 t2 = 
  match t1 with 
    Log_hypothesis_size _ -> 
      begin match t2 with 
	Log_hypothesis_size _ -> true
      |	_ -> false end
  | Log_prior _ -> 
      begin match t2 with 
	Log_prior _ -> true
      |	_ -> false end
  | Delta _ -> 
      begin match t2 with 
	Delta _ -> true
      |	_ -> false end
  | Lower_delta _ -> 
      begin match t2 with 
	Lower_delta _ -> true
      |	_ -> false end
  | Train_errors _ -> 
      begin match t2 with 
	Train_errors _ -> true
      |	_ -> false end
  | Test_errors _ -> 
      begin match t2 with 
	Test_errors _ -> true
      |	_ -> false end
  | Train_examples _ -> 
      begin match t2 with 
	Train_examples _ -> true
      |	_ -> false end
  | Test_examples  _ -> 
      begin match t2 with 
	Test_examples _ -> true
      |	_ -> false end
  | Approximation  _ -> 
      begin match t2 with 
	Approximation _ -> true
      |	_ -> false end
  | Error_log_count  _ -> 
      begin match t2 with 
	Error_log_count _ -> true
      |	_ -> false end
  | Sample_space_log_size  _ -> 
      begin match t2 with 
	Sample_space_log_size _ -> true
      |	_ -> false end

let rec find tipe tags =
  match tags with
    [] -> tipe
  | h::tags_tail -> 
      if (matches tipe h) then h 
      else find tipe tags_tail

let null_log_hypothesis_size = Log_hypothesis_size 0.
let null_delta = Delta 0.5
let null_lower_delta = Lower_delta 0.5
let null_log_prior = Log_prior 0.
let null_train_errors = Train_errors 0
let null_test_errors = Test_errors 0
let null_train_examples = Train_examples 0
let null_test_examples = Test_examples 0
let null_approximation = Approximation Automatic
let null_error_log_count = Error_log_count (0,Log_float.zero)
let null_sample_space_log_size = Sample_space_log_size Log_float.zero

exception Badness

let get_test_examples tags = 
  match find null_test_examples tags with
    Test_examples x -> x
  | _ -> raise Badness
	
let get_train_examples tags = 
  match find null_train_examples tags with
    Train_examples x -> x
  | _ -> raise Badness
	
let get_approximation tags = 
  match find null_approximation tags with
    Approximation x -> x
  | _ -> raise Badness

let get_error_log_count tags = 
  let error_log_counts = List.filter (fun x -> match x with Error_log_count (x,y) -> true | _ -> false) tags in
  if List.length error_log_counts = 0 then 
    Array.create 0 Log_float.zero
  else
    let error_log_counts = List.map (fun x -> match x with Error_log_count (x,y) -> (x,y) | _ -> raise Badness) error_log_counts in
    let train_examples = get_train_examples tags in
    let ret = Array.create (train_examples + 1) Log_float.zero in
    
    List.iter (fun (i,x) -> if i <= train_examples then ret.(i) <- x else raise (Error "shell bound errors greater than training examples")) error_log_counts;
    ret

let get_sample_space_log_size tags =
  match find null_sample_space_log_size tags with
    Sample_space_log_size x -> x
  | _ -> raise Badness

let get_test_errors tags = 
  match find null_test_errors tags with
    Test_errors x -> x
  | _ -> raise Badness

let get_train_errors tags = 
  match find null_train_errors tags with
    Train_errors x -> x
  | _ -> raise Badness

let get_delta tags = 
  match find null_delta tags with
    Delta x -> x
  | _ -> raise Badness
	
let get_lower_delta tags = 
  match find null_lower_delta tags with
    Lower_delta x -> x
  | _ -> raise Badness
	
let get_log_hypothesis tags = 
  match find null_log_hypothesis_size tags with
    Log_hypothesis_size x -> x
  | _ -> raise Badness
	
let get_log_prior tags = 
  match find null_log_prior tags with
    Log_prior x -> x
  | _ -> raise Badness
	
let convert tags = 
  { delta = get_delta tags;
    lower_delta = get_lower_delta tags;
    log_hypothesis_size = get_log_hypothesis tags;  
    log_prior = get_log_prior tags;  
    train_errors = get_train_errors tags;  
    test_errors = get_test_errors tags;  
    train_examples = get_train_examples tags;  
    test_examples = get_test_examples tags;
    approx = get_approximation tags;
    sample_space_log_size = get_sample_space_log_size tags;      
    error_log_count = get_error_log_count tags;      
  }

let print_tags ctags = 
  print_string "delta ";
  print_float ctags.delta;
  print_newline();
  print_string "lower_delta ";
  print_float ctags.lower_delta;
  print_newline();
  if ctags.test_examples > 0 then begin
    print_string "test_examples ";
    print_int ctags.test_examples;
    print_newline();
    print_string "test_errors ";
    print_int ctags.test_errors;
    print_newline();
  end;
  if ctags.train_examples > 0 then begin
    print_string "train_examples ";
    print_int ctags.train_examples;
    print_newline();
    if Array.length ctags.error_log_count > 0 
    then begin
      if ctags.sample_space_log_size <> 0. 
      then print_string ("sample_space_log_size "^string_of_float ctags.sample_space_log_size^"\n");
      
      Array.iteri (fun i c -> 
	if c > Log_float.zero then begin print_string "error_log_count ";print_int i; print_char ' '; 
	  print_float c; print_char ' '; print_newline(); end
	else ()) ctags.error_log_count end
    else begin
      print_string "train_errors ";
      print_int ctags.train_errors;
      print_newline();
      print_string "log_hypothesis_size ";
      print_float ctags.log_hypothesis_size;
      print_newline();
      print_string "log_prior ";
      print_float ctags.log_prior;
      print_newline();
    end;
  end;
  print_string "approximation ";
  print_string 
    begin match ctags.approx with 
      Exact -> "exact"
    | Hoeffding -> "hoeffding"
    | Relative_Entropy -> "relative_entropy"
    | Automatic -> "automatic"
    end;
  print_newline();

    
