Set Warnings "-extraction-opaque-accessed,-extraction".
Set Warnings "-notation-overridden,-parsing".
(* end randomSplitAssumption *)
CoInductive RandomSeedTree :=
| RstNode : RandomSeed -> RandomSeedTree -> RandomSeedTree -> RandomSeedTree.
Definition root_rst (rst : RandomSeedTree) : RandomSeed :=
match rst with
| RstNode root _ _ => root
end.
Definition left_rst (rst : RandomSeedTree) : RandomSeedTree :=
match rst with
| RstNode _ t1 _ => t1
end.
Definition right_rst (rst : RandomSeedTree) : RandomSeedTree :=
match rst with
| RstNode _ _ t2 => t2
end.
Inductive PrefixFree : list SplitPath -> Prop :=
| FreeNil : PrefixFree []
| FreeCons : forall (p : SplitPath) (l : list SplitPath),
PrefixFree l ->
(forall (p' : SplitPath), In p' l ->
(forall p1 p2, p' ++ p1 = p ++ p2-> False)) ->
PrefixFree (p :: l).
intro.
apply FreeCons.
+ apply FreeNil.
+ intros. inversion H.
Qed.
intros.
destruct l; auto.
inversion H.
subst.
pose proof H3 l.
assert (In l (l :: l0)) by (left; auto).
eapply H0 in H1. inversion H1.
instantiate (2 := []). rewrite app_nil_r; simpl; eauto.
Qed.
Inductive correspondingSeedTree (l : list SplitPath) (f : SplitPath -> RandomSeed)
(st : SeedTree) : Prop :=
| Corresponding : (forall (p : SplitPath) s, varySeed' st p = Some s -> In p l) ->
(forall (p : SplitPath), In p l -> varySeed' st p = Some (f p)) ->
PrefixFree l ->
correspondingSeedTree l f st.
intro f.
apply Corresponding.
+ intros p s Contra.
inversion Contra.
+ intros p InNil. inversion InNil.
+ apply FreeNil.
Qed.
Ltac fireInLeft name :=
match goal with
| [H : In ?X (?X :: ?XS) -> _ |- _ ] =>
assert (In X (X :: XS)) as name by (left; auto); apply H in name; clear H
end.
intros l f Corr.
inversion Corr as [Vary_In In_Vary Pref]; clear Corr.
destruct l as [ | p ps]; auto.
clear Vary_In Pref.
pose proof (In_Vary p) as Contra; clear In_Vary.
fireInLeft Hyp.
inversion Hyp.
Qed.
intros.
inversion H; subst.
destruct l eqn:L; auto.
pose proof (H3 l0).
assert (In l0 (l0 :: l1)) by (left; auto).
eapply H0 in H1.
+ inversion H1.
+ instantiate (1 := l0). instantiate (1 := []). rewrite app_nil_r. auto.
Qed.
intros s l f Corr.
inversion Corr as [Vary_In In_Vary Pref]; clear Corr.
pose proof (Vary_In [] s) as Hyp; clear Vary_In.
simpl in Hyp.
assert (InNilL : In [] l) by (apply Hyp; auto); clear Hyp.
split.
+ destruct l eqn:L.
- inversion InNilL.
- destruct s0 eqn : S0.
* apply PrefixFreeWithNil in Pref; subst; auto.
* pose proof (In_Vary (s1 :: s2)) as Hyp; clear In_Vary.
+ inversion Pref.
fireInLeft Hyp'. simpl in Hyp'. inversion Hyp'.
+ pose proof In_Vary [] as Hyp; clear In_Vary.
apply Hyp in InNilL; clear Hyp.
simpl in *.
congruence.
Qed.
unfold not; intros st1 st2 l p f Corr InPL PNil; subst.
inversion Corr as [_ In_Vary _]; clear Corr.
pose proof (In_Vary []) as Hyp; clear In_Vary.
apply Hyp in InPL; clear Hyp.
simpl in InPL.
inversion InPL.
Qed.
Hint Resolve corrEmptyUndef.
Hint Resolve corrNodeNonEmpty.
Definition Direction_eq_dec : forall (d1 d2 : SplitDirection),
{d1 = d2} + {d1 <> d2}.
decide equality.
Qed.
Definition eq_dir_b (d1 d2 : SplitDirection) : bool :=
match d1,d2 with
| Left, Left => true
| Right, Right => true
| _, _ => false
end.
intros.
unfold eq_dir_b.
destruct d1; destruct d2; split; auto; intro Contra; inversion Contra.
Qed.
Definition refineList (d : SplitDirection) (l : list SplitPath) : list SplitPath :=
map (@tl SplitDirection) (filter (fun p => match hd_error p with
| Some d' => eq_dir_b d d'
| _       => false
end) l).
intros d l p.
unfold refineList.
rewrite in_map_iff.
intros.
inversion H; clear H.
inversion H0; clear H0.
generalize H1; clear H1.
rewrite filter_In.
intros.
inversion H0; clear H0.
unfold tl in H.
destruct x eqn:X.
+ simpl in H2. inversion H2.
+ simpl in H2. apply eq_dir_b_eq in H2. subst. auto.
Qed.
intros.
unfold refineList.
apply in_map_iff.
exists (d :: p).
split; auto.
apply filter_In.
split; simpl; auto.
unfold eq_dir_b; destruct d; auto.
Qed.
intros.
induction l.
- unfold refineList; constructor.
- destruct a eqn:A; subst.
* apply prefixFreeEmpty in H. subst. unfold refineList. simpl. constructor.
* destruct s eqn:S; destruct d; subst.
+ unfold refineList; simpl.
eapply FreeCons.
- apply IHl. inversion H; auto.
- intros. inversion H; subst; clear H.
apply in_map_iff in H0.
inversion H0; subst; clear H0.
inversion H; subst; clear H.
apply filter_In in H2. inversion H2; subst; clear H2.
destruct x eqn:X; simpl in *. inversion H0.
destruct s eqn:S; simpl in *.
pose proof H5 (Left :: l0).
eapply H2 in H; auto.
simpl. instantiate (1 := p2). instantiate (1:= p1). rewrite H1. auto.
inversion H0.
+ unfold refineList; simpl. apply IHl.
inversion H. auto.
+ unfold refineList; simpl. apply IHl.
inversion H. auto.
+ unfold refineList; simpl.
eapply FreeCons.
- apply IHl. inversion H; auto.
- intros. inversion H; subst; clear H.
apply in_map_iff in H0.
inversion H0; subst; clear H0.
inversion H; subst; clear H.
apply filter_In in H2. inversion H2; subst; clear H2.
destruct x eqn:X; simpl in *. inversion H0.
destruct s eqn:S; simpl in *.
inversion H0.
pose proof H5 (Right :: l0).
eapply H2 in H; auto.
simpl. instantiate (1 := p2). instantiate (1:= p1). rewrite H1. auto.
Qed.
Definition refineFunction (f : SplitPath -> RandomSeed) (d : SplitDirection) (arg : SplitPath) :
RandomSeed :=
f (d :: arg).

Lemma refineFunCorrect : forall f d p, f (d :: p) = (refineFunction f d) p.