(*START HERE*)
  Fixpoint fullTreeP (t : ShareTree) (d  : nat): Prop :=
   match t with
    | Leaf b => d = 0
    | Node l r => (d > 0) /\ (fullTreeP l (d - 1)) /\ (fullTreeP r (d - 1))
   end.Definition fullTree (t : ShareTree) : Prop :=
   fullTreeP t (tree_heightP t).Fixpoint mkFull (d : nat)  (t : ShareTree) : option ShareTree :=
   match d with
    |0 => match t with
          |Leaf b => Some (Leaf b)
          |Node l r => None
          end
    |S n => match t with
            |Leaf b => match (mkFull n (Leaf b)) with
                       | Some t => Some (Node t t)
                       |_ => None
                       end
            |Node l r => match (mkFull n l, mkFull n r) with
                         | (Some t1, Some t2) => Some (Node t1 t2)
                         |_ => None
                         end
             end
   end.Fixpoint tree_round_leftP (n : nat) (t : ShareTree) : option ShareTree :=
    match n with
    | 0 => None
    | 1 => match t with
           | Node (Leaf b1) (Leaf b2) => Some (Leaf b1)
           |_=> None
           end
    | S n' => match t with
              | Leaf b => Some (Leaf b)
              | Node t1 t2 => match (tree_round_leftP n' t1, tree_round_leftP n' t2) with
                              | (Some t1', Some t2') => Some (Node t1' t2')
                              | _ => None
                              end
              end
    end.Definition tree_round_left (n : nat) (t : canonTree) : option canonTree:=
    match mkFull n (proj1_sig t) with
    | Some t' => match tree_round_leftP n t' with
                  | Some t'' => Some (exist (fun t => canonicalTree t) (mkCanon t'') (mkCanon_correct _))
                  | None => None
                  end
     | None => None
     end.Instance  roundableL_tree : roundableLeft t :=
    RoundableLeft tree_round_left.Fixpoint tree_round_rightP (n : nat) (t : ShareTree) : option ShareTree :=
    match n with
    | 0 => None
    | 1 => match t with
           | Node (Leaf b1) (Leaf b2) => Some (Leaf b2)
           |_=> None
           end
    | S n' => match t with
              | Leaf b => Some (Leaf b)
              | Node t1 t2 => match (tree_round_rightP n' t1, tree_round_rightP n' t2) with
                              | (Some t1', Some t2') => Some (Node t1' t2')
                              | _ => None
                              end
              end
    end.Definition tree_round_right (n : nat) (t : canonTree) : option canonTree:=
    match mkFull n (proj1_sig t) with
    | Some t' => match tree_round_rightP n t' with
                  | Some t'' => Some (exist (fun t => canonicalTree t) (mkCanon t'') (mkCanon_correct _))
                  | None => None
                  end
     | None => None
     end.Instance  roundableR_tree : roundableRight t :=
   RoundableRight tree_round_right.Fixpoint tree_avgP (t1 t2 : ShareTree) : option ShareTree :=
    match (t1,t2) with
    |(Leaf b1, Leaf b2) => Some (Node (Leaf b1) (Leaf b2))
    |(Node t11 t12, Node t21 t22) => match (tree_avgP t11 t21, tree_avgP t12 t22) with
                                     |(Some t1', Some t2') => Some (Node t1' t2')
                                     |_ => None
                                     end
    |_ => None
    end.Definition tree_avg (n : nat) (t1 t2 : canonTree) : option canonTree :=
    match n with
    |0 => None
    |S n' => match (mkFull n' (proj1_sig t1), mkFull n' (proj1_sig t2)) with
             |(Some t1', Some t2') => match (tree_avgP t1' t2') with
                                      |Some t' => Some (exist (fun t => canonicalTree t) (mkCanon t') (mkCanon_correct _))
                                      |None => None
                                      end
             |_ => None
             end
    end.Instance avgable_tree : avgable t :=
     Avgable tree_avg.

(* Specifications: *)
Lemma compose_canon1 : forall b1 b2,b1 <> b2 -> canonicalTree (Leaf b1) -> canonicalTree (Leaf b2) -> canonicalTree (Node (Leaf b1) (Leaf b2)).
Lemma compose_canon2 : forall b t1 t2, canonicalTree (Leaf b) -> canonicalTree (Node t1 t2)-> canonicalTree (Node (Leaf b) (Node t1 t2)).
Lemma compose_canon3 : forall t1 t2 b, canonicalTree (Node t1 t2)-> canonicalTree (Leaf b) -> canonicalTree (Node (Node t1 t2) (Leaf b) ).
Lemma compose_canon4 : forall t1 t2 t3 t4, canonicalTree (Node t1 t2) -> canonicalTree (Node t3 t4) -> canonicalTree (Node (Node t1 t2) (Node t3 t4)).