(*********************************************)
(* This file is part of the 'Higman' contrib *)
(* file : higman_aux.v                       *)
(* contains : auxiliary forest functions     *)
(*  definitions and their main properties    *)
(* author : W.Delobel                        *)
(*********************************************)
Set Implicit Arguments.
Require Export inductive_wqo.
Require Export tree.
Require Export list_embeding.
Section higman_aux.
Variable A : Set.
Variable leA : A -> A -> Prop.
Hypothesis eqA_dec : forall a a' : A, {a = a'} + {a <> a'}.
Hypothesis leA_dec : forall a a', {leA a a'} + {~ leA a a'}.
Hypothesis leA_trans : forall a a' a'', leA a a' -> leA a' a'' -> leA a a''.
Definition embeds : list A -> list A -> Prop := Embeds leA.
Definition sublist : list (list A) -> list (list A) -> Prop := Embeds (eq (A:= list A)).
Fixpoint firsts (l : list (list A)) : list A :=
match l with
| nil => nil
| w::ws => match w with
| nil => nil
| a::w' => a :: (firsts ws)
end
end.
Definition Tree := tree (list (list A) * (list A)).
Fact eq_Tree_dec : forall t t' : Tree, {t = t'} + {t <> t'}.
Definition root_label (t : Tree) : option A :=
match (root t) with
| (l,r) => head r
end.
Fixpoint roots_labels (ts : list Tree) : option (list A) :=
match ts with
| nil => Some nil
| t :: ts' => match (root_label t) with
| None => None
| Some a => match (roots_labels ts') with
| Some ts'' => Some (a :: ts'')
| None => None
end
end
end.
Inductive is_insert_forest : list Tree -> list A -> A -> list Tree -> Prop :=
| is_if0 : forall w a, is_insert_forest nil w a nil
| is_if2 : forall vs a' ts f w a f' l,
is_insert_forest f w a f' ->
~(leA a' a) ->
is_insert_forest ((node (vs,a'::l) ts) :: f) w a ((node (vs,a'::l) ts) :: f')
| is_if4 : forall vs a'  ts f w a t' l,
leA a' a ->
is_insert_tree (node (vs,a'::l) ts) w a t' ->
is_insert_forest ((node (vs,a'::l) ts):: f) w a (t' :: f)
with is_insert_tree : Tree -> list A -> A -> Tree -> Prop :=
| is_it1 : forall vs l ts w a rrts,
roots_labels ts = Some rrts ->
~ greater leA a rrts ->
is_insert_tree (node (vs,l) ts) w a (node (vs,l) ((node (w::vs, a::l) ts) :: ts))
| is_it2 : forall l ts w a rrts f',
roots_labels ts = Some rrts ->
greater leA a rrts ->
is_insert_forest ts w a f' ->
is_insert_tree (node l ts) w a (node l f').
Inductive is_forest : list (list A) -> list Tree -> Prop :=
| is_f0 : is_forest nil nil
| is_f1 : forall a w ws f f',  is_forest ws f ->
greater leA a (bad_subsequence leA leA_dec (firsts ws)) ->
is_insert_forest f w a f' -> is_forest ((a::w)::ws) f'
| is_f2 : forall a w ws f,  is_forest ws f ->
~ greater leA a (bad_subsequence leA leA_dec (firsts ws)) ->
is_forest ((a::w)::ws) ((node (w::ws, a::nil) f)::f).
Section through_is_insert.
Variable P : list (list A) -> Tree -> Prop.
Definition P_on_tree (ws : list (list A)) (t : Tree) : Prop := forall t', subtree t' t -> P ws t'.
Definition P_on_forest (ws : list (list A)) (f : list Tree) : Prop :=
forall t, tree_in_forest t f -> P ws t.
Fact P_on_node : forall a ts ws, P_on_tree ws (node a ts) ->
forall t, In t ts -> P_on_tree ws t.
Definition from_insert_forest (t : Tree) (a : A) : Prop :=
forall a' l vs ts, t = node (vs, a'::l) ts -> leA a' a.
Hypothesis P_added_node : forall ws w vs a l ts, from_insert_forest (node (vs,l) ts) a ->
P ws (node (vs,l) ts) ->
P ((a::w)::ws) (node (w::vs, a::l) ts).
Hypothesis P_added_node_base : forall ws w a f, P_on_forest ws f ->
P ((a::w)::ws) (node (w::ws,a::nil) f).
Hypothesis P_split : forall ws a t f, P ws (node a (t::f)) -> P ws t -> P ws (node a f).
Hypothesis P_merge : forall ws a t f, P ws (node a f) -> P ws t -> P ws (node a (t::f)).
Hypothesis P_add : forall w ws t, P ws t -> P (w::ws) t.

Lemma is_insert_tree_invariant : forall ws t w a t',
from_insert_forest t a ->
is_insert_tree t w a t' ->
P_on_tree ws t -> P_on_tree ((a::w)::ws) t'.