Section Tree.
Variable A : Type.
Variable eqA_dec : forall a b : A, {a = b} + {a <> b}.
Variable empty : A.
(* Definition of binary trees *)
Inductive btree : Type :=
| leaf : A -> btree
| node : btree -> btree -> btree.
(* Predicate that defines belonging *)
Inductive inb : btree -> btree -> Prop :=
| inleaf : forall t : btree, inb t t
| innodeL : forall t t1 t2 : btree, inb t t1 -> inb t (node t1 t2)
| innodeR : forall t t1 t2 : btree, inb t t2 -> inb t (node t1 t2).
Hint Constructors inb : core.
Proof using.
intros t1 t2 t3 H H1; generalize t1 H; elim H1; clear H H1 t1 t2 t3; auto.
Qed.
Proof using.
intros t; elim t; simpl in |- *; auto.
intros a; exists a; auto.
intros b (a, H) b0 H0; exists a; auto.
Qed.
(* Compute the number of nodes of a tree *)
Fixpoint number_of_nodes (b : btree) : nat :=
match b with
| leaf _ => 0
| node b1 b2 => S (number_of_nodes b1 + number_of_nodes b2)
end.
Proof using.
intros t1 t2 H; elim H; clear H t1 t2; simpl in |- *; auto.
intros t t1 t2 H H0; apply le_trans with (1 := H0); auto with arith.
intros t t1 t2 H H0; apply le_trans with (1 := H0); auto with arith.
Qed.
Proof using.
intros t1 t2 H; elim H; auto.
intros t t0 t3 H0 H1 H2.
absurd (number_of_nodes (node t0 t3) <= number_of_nodes t).
rewrite H1; simpl in |- *; auto with arith.
apply inb_trans with (2 := H2); auto.
apply number_of_nodes_inb_le; auto.
intros t t0 t3 H0 H1 H2.
absurd (number_of_nodes (node t0 t3) <= number_of_nodes t).
rewrite H1; simpl in |- *; auto with arith.
apply inb_trans with (2 := H2); auto.
apply number_of_nodes_inb_le; auto.
Qed.
(* equality on trees is decidable  *)
Definition btree_dec : forall a b : btree, {a = b} + {a <> b}.
intros a; elim a.
intros a1 b; case b.
intros b1; case (eqA_dec a1 b1).
intros e; left; rewrite e; auto.
intros e; right; Contradict e; inversion e; auto.
intros b0 b1; right; red in |- *; intros H; discriminate.
intros b H b0 H0 b1; case b1.
intros a0; right; red in |- *; intros H1; discriminate.
intros b2 b3; case (H b2); intros H1.
case (H0 b3); intros H2.
left; rewrite H1; rewrite H2; auto.
right; rewrite H1; Contradict H2; inversion H2; auto.
right; Contradict H1; inversion H1; auto.
Defined.
(* Belonging is decidable *)
Definition inb_dec : forall a p, {inb a p} + {~ inb a p}.
intros a; elim a; simpl in |- *; auto; clear a.
intros a p; elim p; simpl in |- *; auto; clear p.
intros a1; case (eqA_dec a a1); intros Ha.
left; rewrite Ha; simpl in |- *; auto.
right; red in |- *; Contradict Ha; inversion Ha; auto.
intros b [H| H]; auto.
intros b0 [H1| H1]; auto.
right; red in |- *; intros H2; inversion H2.
case H; auto.
case H1; auto.
intros b H b0 H0 p; elim p; auto.
intros a; right; red in |- *; intros H1; inversion H1.
intros b1 H1 b2 H2.
case H1; intros H3; auto.
case H2; intros H4; auto.
case (btree_dec (node b b0) (node b1 b2)); intros H5.
left; rewrite H5; auto.
right; red in |- *; intros H6; inversion H6; auto.
case H5; rewrite H9; rewrite H10; auto.
Defined.
(* Compute all the leaves of the tree *)
Fixpoint all_leaves (t : btree) : list A :=
match t with
| leaf a => a :: nil
| node t1 t2 => all_leaves t1 ++ all_leaves t2
end.
Proof using.
intros t; elim t; simpl in |- *; auto.
intros a a0 H; inversion H; auto.
intros b H b0 H0 a H1; apply in_or_app; inversion H1; auto.
Qed.
Proof using.
intros t; elim t; simpl in |- *; auto.
intros a a0 [H| H]; [ rewrite H | case H ]; auto.
intros b H b0 H0 a H1; case in_app_or with (1 := H1); auto.
Qed.
(* The property for a tree to have distinct leaves  *)
Definition distinct_leaves (t : btree) : Prop :=
forall t0 t1 t2 : btree,
inb (node t1 t2) t -> inb t0 t1 -> inb t0 t2 -> False.
Proof using.
intros a; red in |- *.
intros a0 t1 t2 H; inversion H.
Qed.
Hint Resolve distinct_leaves_leaf : core.
Proof using.
intros t1 t2 H; red in |- *.
intros a t0 t3 H0 H1 H2.
apply (H a t0 t3); auto.
Qed.
Proof using.
intros t1 t2 H; red in |- *.
intros a t0 t3 H0 H1 H2.
apply (H a t0 t3); auto.
Qed.
Proof using.
intros t; elim t; simpl in |- *; auto.
intros b H b0 H0 H1; red in |- *.
intros t0 t1 t2 H2; inversion H2.
intros H4 H7; case (inb_ex t0); intros a HH.
apply ulist_app_inv with (a := a) (1 := H1); auto; apply all_leaves_in;
apply inb_trans with (1 := HH); auto.
apply H; auto; try apply ulist_app_inv_l with (1 := H1).
apply H0; auto; try apply ulist_app_inv_r with (1 := H1).
Qed.
Proof using.
intros t; elim t; simpl in |- *; auto.
intros b H b0 H0 H1; apply ulist_app; auto.
apply H; apply distinct_leaves_l with (1 := H1).
apply H0; apply distinct_leaves_r with (1 := H1).
intros a H2 H3; case (H1 (leaf a) b b0); auto.
apply all_leaves_inb with (1 := H2).
apply all_leaves_inb with (1 := H3).
Qed.
(* Uniqueleaf is decidable *)
Definition distinct_leaves_dec :
forall a, {distinct_leaves a} + {~ distinct_leaves a}.
intros a; case (ulist_dec A eqA_dec (all_leaves a)); intros H.
left; apply all_leaves_unique; auto.
right; Contradict H; apply all_leaves_ulist; auto.
Defined.
(* Compute the code associated with a binary tree *)
Fixpoint compute_code (a : btree) : list (A * list bool) :=
match a with
| leaf b => (b, nil) :: nil
| node l1 l2 =>
map
(fun v : A * list bool =>
match v with
| (a1, b1) => (a1, false :: b1)
end) (compute_code l1) ++
map
(fun v : A * list bool =>
match v with
| (a1, b1) => (a1, true :: b1)
end) (compute_code l2)
end.
Proof using.
intros t; elim t; simpl in |- *; auto with arith.
intros b H b0 H0; rewrite length_app.
replace 0 with (0 + 0); auto with arith.
apply plus_lt_compat.
generalize H; elim (compute_code b); simpl in |- *; auto with arith.
generalize H0; elim (compute_code b0); simpl in |- *; auto with arith.
Qed.
Hint Resolve length_compute_lt_O : core.
Proof using.
intros t; elim t; simpl in |- *; auto.
intros a a0 l [H1| H1]; try (case H1; fail).
injection H1; intros H2 H3; rewrite H3; auto.
intros h H h0 H0 a l H1.
case in_app_or with (1 := H1); auto; intros H2.
case in_map_inv with (1 := H2).
intros (a1, l1) (Ha1, Hl1); auto.
apply innodeL; apply (H a l1).
injection Hl1; intros Hl2 Hl3; rewrite Hl3; auto.
case in_map_inv with (1 := H2).
intros (a1, l1) (Ha1, Hl1); auto.
apply innodeR; apply (H0 a l1).
injection Hl1; intros Hl2 Hl3; rewrite Hl3; auto.
Qed.
Proof using.
intros a p; elim p; simpl in |- *; auto.
intros a0 H; inversion H.
exists (nil (A:=bool)); auto.
intros p0 H p1 H0 H1; inversion H1.
case H; auto.
intros x Hx; exists (false :: x).
apply in_or_app; left; auto.
change
(In ((fun v => match v with
| (a1, b1) => (a1, false :: b1)
end) (a, x))
(map (fun v => match v with
| (a1, b1) => (a1, false :: b1)
end) (compute_code p0))) in |- *;
apply in_map; auto.
case H0; auto.
intros x Hx; exists (true :: x).
apply in_or_app; right; auto.
change
(In ((fun v => match v with
| (a1, b1) => (a1, true :: b1)
end) (a, x))
(map (fun v => match v with
| (a1, b1) => (a1, true :: b1)
end) (compute_code p1))) in |- *;
apply in_map; auto.
Qed.

(* The computed code is in the alphabet of its leaves *)
Theorem in_alphabet_compute_code :
forall m t,
(forall a : A, In a m -> inb (leaf a) t) -> in_alphabet m (compute_code t).