Definition is_black_balanced (t : tree) : bool :=
  isSome (black_height_bool t).Fixpoint has_no_red_red (c : color) (t : tree) : bool :=
  match t with
    | Leaf => true
    | Node Red t1 _ t2 =>
      match c with
        | Red => false
        | Black => has_no_red_red Red t1 && has_no_red_red Red t2
      end
    | Node Black t1 _ t2 =>
      has_no_red_red Black t1 && has_no_red_red Black t2
  end.(* begin is_redblack_bool *)
Definition is_redblack_bool (t : tree) : bool :=
  is_black_balanced t && has_no_red_red Red t.(* end is_redblack_bool *)

Fixpoint showColor (c : color) :=
  match c with
    | Red => "Red"
    | Black => "Black"
  end.Fixpoint tree_to_string (t : tree) :=
  match t with
    | Leaf => "Leaf"
    | Node c l x r => "Node " ++ showColor c ++ " "
                            ++ "(" ++ tree_to_string l ++ ") "
                            ++ show x ++ " "
                            ++ "(" ++ tree_to_string r ++ ")"
  end.Instance showTree {A : Type} `{_ : Show A} : Show tree :=
  {|
    show t := "" (* CH: tree_to_string t causes a 9x increase in runtime *)
  |}.(* begin genAnyTree *)
Definition genColor := elems [Red; Black].Fixpoint genAnyTree_depth (d : nat) : G tree :=
  match d with 
    | 0 => returnGen Leaf
    | S d' => freq [(1, returnGen Leaf);
                    (9, liftGen4 Node genColor (genAnyTree_depth d')
                                     arbitrary (genAnyTree_depth d'))]
  end.Definition genAnyTree : G tree := sized genAnyTree_depth.Definition test_naive :=
  insert_preserves_redblack_checker genAnyTree.(* begin QC_naive *)
(*! QuickChick test_naive. *)
(* end QC_naive *)

(* gathering some size statistics *)
Fixpoint tree_size (t : tree) : nat :=
  match t with
    | Leaf => 1
    | Node c tl _ tr => 1 + (tree_size tl) + (tree_size tr)
  end.Notation "'do!' X <- A ; B" :=
  (bindGen A (fun X => B))
  (at level 200, X ident, A at level 100, B at level 200).Definition ltColor (c1 c2: color) : Prop :=
  match c1, c2 with
    | Red, Black => True
    | _, _ => False
  end.

(* Specifications: *)
Lemma well_foulded_ltColor : well_founded ltColor.