(*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)).