Require Import Bool Arith List Omega.
Require Import Recdef Morphisms.
Require Import Program.Tactics.
Require Import Relation_Operators.
Require FMapList.
Require FMapFacts.
Require Import Classical.
Require Import Coq.Classes.RelationClasses.
Require Import OrderedType OrderedTypeEx DecidableType.
Require Import Sorting.Permutation.
Import ListNotations.
Module NatMap := FMapList.Make Nat_as_OT.

Definition address := nat.
Definition version := nat.
Definition value := nat.
Definition lock := bool.
Definition variable := nat.
Definition store := NatMap.t value.
Definition heap :=  address -> option (value * lock * version).
Definition tid := nat.
(*
Inductive log : Type :=
|Read : address -> version -> log -> log
|Write : address -> value -> log -> log
|NilLog : log.

Function log_read_only (l:log) : Prop :=
  match l with
   | NilLog => True
   | Read _ _ s => log_read_only s
   | Write _ _ _ => False
  end.

Inductive operation :=
|  read: address -> variable -> operation
|  write: address -> value -> operation.

Definition transaction := list operation.

Inductive trans_state : Type :=
| TS: forall (s: store) (h: heap) (l: log), trans_state.

Inductive trans_step1 : relation trans_state :=
| TS_read: forall s h addr l var val lck ver,
	h addr = Some (val, lck, ver) ->
	lck = false ->
	trans_step1 (TS s h l) (TS (NatMap.add var val s) h (Read addr ver l))
|TS_write: forall s h addr l val,
	trans_step1 (TS s h l) (TS s h (Write addr val l)).
*)
(*
1. What operations do we need to support? For example, non-transactional operations, write from a read, etc
2. What is the difference between the inductive style that we are using and the functional style?
   We followed your style in osview.
3. What is the next step?
4. How to model concurrency?

forall traces t, if t is sto_trace, then there exists a reorder trace t' where t' reorders t and t' is a sto-trace
and t' is a serial trace

Let's say each trace is each element belongs to a transaction
serial means all operations on a transaction grouped

Action:=
|start_txn: tid -> action
|read_item: tid -> addr -> action
|write_item: tid -> addr -> value -> action
|try_commit_txn: tid -> action
|lock_write_item: tid -> addr -> action
|validate_read_item: tid -> addr -> version -> action
|abort_txn: tid -> action
|complete_write_item: tid -> addr -> value -> action
|invalid_write_item: tid -> addr -> value -> action
|commit_txn: tid -> action
|obtain_global_tid (must call after all write items are locked)

global_tid order produces the same result, same memory and every read returns the same value

sto_trace may should be inductive type
should probably have a reorder operation
How do you define reorder? How do you define serial?
Do you want to use os_step trick of collecting explicit history?
** Reordering definition is important **
*)
Inductive action:=
|dummy: action
|start_txn: action
|read_item: version -> action
|write_item: value -> action
|try_commit_txn: action
|lock_write_item: action
|validate_read_item: Prop -> action
|abort_txn: action
(*|restart_txn: action*)
|complete_write_item: (*value -> action*)version -> action
(*|unlock_write_item: version -> action*)
(*|invalid_write_item: value -> action*)
|commit_txn: version -> action
|seq_point: action.
(*|obtain_global_tid: action.*)
(*sp later than last lock, but must before the first commit*)
Definition trace := list (tid * action).

(*
Returns all tid*action with tid tid in the trace.
*)
Definition trace_filter_tid tid tr : trace :=
    filter (fun pr => fst pr =? tid) tr.

(*
Returns all commit actions in the trace.
*)
Definition trace_filter_commit tr: trace :=
    filter (fun pr => match snd pr with
                      | commit_txn _ => true
                      | _ => false
                      end) tr.
(*
Returns all write actions in the trace.
*)
Definition trace_filter_write tr: trace :=
    filter (fun pr => match snd pr with
                      | write_item _ => true
                      | _ => false
                      end) tr.

(*
Returns all read actions in the trace.
*)
Definition trace_filter_read tr: trace :=
    filter (fun pr => match snd pr with
                      | read_item _ => true
                      | _ => false
                      end) tr.

(*
Returns all commit & complete_write actions in the trace for updating commit version
*)
Definition trace_filter_commit_complete tr: trace :=
    filter (fun pr => match snd pr with
                      | commit_txn _ => true
                      | complete_write_item _ => true
                      | _ => false
                      end) tr.

(*
Returns the last action of the transaction tid
Returns dummy if there is no transaction with id tid.
*)
Definition trace_tid_last tid t: action :=
    hd dummy (map snd (trace_filter_tid tid t)).

(*
Returns the version number of the last commit
If there is no commit in the trace, returns 0.
*)
Definition trace_commit_last t: version :=
  match hd dummy (map snd (trace_filter_commit t)) with
	| commit_txn n => n
	| _ => 0
  end.

(*
Returns the value of the last write
If there is no write in the trace, returns 0.
*)
Definition trace_write_last t: value :=
  match hd dummy (map snd (trace_filter_write t)) with
	| write_item n => n
	| _ => 0
  end.

(*
Returns the version number of the last commit/complete_write
If there is no commit in the trace, returns 0.
*)
Definition trace_commit_complete_last t: version :=
  match hd dummy (map snd (trace_filter_commit_complete t)) with
	| commit_txn n => n
  | complete_write_item n => n
	| _ => 0
  end.

(*
Returns all lock_write_item actions in the trace.
*)
Definition trace_filter_lock tr: trace :=
    filter (fun pr => match snd pr with
                      | lock_write_item => true
                      | _ => false
                      end) tr.

(*
All commit and abort have unlock_write_item.
If a transaction contains either of the actions, the transaction has unlock
*)
Definition trace_filter_unlock tr: trace :=
    filter (fun pr => match snd pr with
                      | commit_txn _ => true
                      | abort_txn => true
                      | _ => false
                      end) tr.

(*
Returns the length of a trace
*)
Function length (tr: trace) : nat :=
  match tr with
  | [] => 0
  | _ :: tr' => S (length tr')
  end.

(*
Returns True if there exists no lock_write_item
Returns False if there exists locks
*)
Definition check_lock_or_unlock tr: Prop :=
  match
    length (trace_filter_lock tr) <=? length (trace_filter_unlock tr)
  with
	| true => True
	| false => False
  end.

(*
Returns true if an action is not a write action
Returns false if an action is a write action.
*)
Definition action_no_write e : Prop :=
  match e with
  | write_item  _  => False
  | _ => True
  end.

(*
Returns true if an action is not a commit_txn action
Returns false if an action is a commit_txn action.
*)
Definition action_no_commit e : Prop :=
  match e with
  | commit_txn _ => False
  | _ => True
  end.

(*
Returns true if the transaction tid's trace has no writes
Returns false otherwise.
*)
Definition trace_no_writes tid t: Prop :=
  Forall action_no_write (map snd (trace_filter_tid tid t)).

(*
Returns true if the transaction tid's trace has no commits
Returns false otherwise.
*)
Definition trace_no_commits tid t: Prop :=
  Forall action_no_commit (map snd (trace_filter_tid tid t)).

(*
Returns all read_item versions in a trace of a particular transaction.
*)
Function read_versions tr: list version :=
  match tr with
   | [] => []
   | (read_item v) :: tail =>  v :: read_versions tail
   | _ :: tail => read_versions tail
  end.

(*
Returns all read_item versions of tid in a trace tr.
*)
Definition read_versions_tid tid tr: list version :=
  read_versions (map snd (trace_filter_tid tid tr)).

(*
Returns True if reads are valid
Returns False otherwise
*)
Function check_version (vs : list version) (v : version) : Prop :=
  match vs with
  | [] => True
  | hd :: tail => if hd =? v then check_version tail v
                  else False
  end.

(*
Returns all start/read/write actions in the trace.
*)
Definition trace_filter_startreadwrite tid tr: trace :=
    filter (fun pr => (fst pr =? tid) &&
                      (match snd pr with
                      | read_item _ => true
                      | write_item _ => true
                      | start_txn => true
                      | _ => false
                      end)) tr.

(*
Returns all newtid with start/read/write actions in the trace.
*)
(*
Function trace_rollback (newtid: nat) (newver: version) (tr:trace): trace :=
    match tr with
    | [] => []
    | (tid, read_item _) :: tr'
      => [(newtid, read_item newver)] ++ trace_rollback newtid newver tr'
    | (tid, write_item val) :: tr'
      => [(newtid, write_item val)] ++ trace_rollback newtid newver tr'
    | (tid, start_txn) :: tr'
      => [(newtid, start_txn)] ++ trace_rollback newtid newver tr'
    | _ :: tr' => trace_rollback newtid newver tr'
  end.
*)

Inductive sto_trace : trace -> Prop :=

| empty_step : sto_trace []

| start_txn_step: forall t tid,
    trace_tid_last tid t = dummy (* this tid doesn’t have start_txn*)
    -> sto_trace t
    -> sto_trace ((tid, start_txn)::t)

| read_item_step: forall t tid val oldver,
    trace_tid_last tid t = start_txn (* start/read/write before read*)
		\/ trace_tid_last tid t = read_item oldver
    \/ trace_tid_last tid t = write_item val
    (*check locked or not*)
    -> check_lock_or_unlock t
    -> sto_trace t
    -> sto_trace ((tid, read_item (trace_commit_last t)) :: t)

| write_item_step: forall t tid oldval val ver,
    trace_tid_last tid t = start_txn
		\/ trace_tid_last tid t = read_item ver
    \/ trace_tid_last tid t = write_item oldval
    -> sto_trace t
    -> sto_trace ((tid, write_item val) :: t)

| try_commit_txn_step: forall t tid ver val,
			trace_tid_last tid t = read_item ver
			\/ trace_tid_last tid t = write_item val
			-> sto_trace t
			-> sto_trace ((tid, try_commit_txn)::t)

| lock_write_item_step: forall t tid,
			trace_tid_last tid t = try_commit_txn
			/\ ~ trace_no_writes tid t
      -> check_lock_or_unlock t
			-> sto_trace t
			-> sto_trace ((tid, lock_write_item) :: t)

| validate_read_item_step: forall t tid,
			(trace_tid_last tid t = try_commit_txn /\ trace_no_writes tid t ) (*read only*)
			\/ trace_tid_last tid t = lock_write_item (*lock write*)
			-> sto_trace t
			-> sto_trace ((tid, validate_read_item (check_version (read_versions_tid tid t)  (trace_commit_last t) ))::t)

(****************************************)
(*| abort_readonly_txn_step: forall t tid,
      trace_tid_last tid t = validate_read_item False (*invalid*)
      /\ trace_no_writes tid t
      -> sto_trace t
      -> sto_trace ((tid, abort_txn) :: t)

| abort_write_txn_step: forall t tid,
      trace_tid_last tid t = validate_read_item False (*invalid*)
      /\ ~ trace_no_writes tid t
      -> sto_trace t
      -> sto_trace ([(tid, abort_txn); (tid, unlock_write_item (trace_commit_last t))] ++ t)*)
(****************************************)

| abort_txn_step: forall t tid,
      trace_tid_last tid t = validate_read_item False
      -> sto_trace t
      -> sto_trace ((tid, abort_txn) :: t) (*abort will contain unlock....*)

| complete_write_item_step: forall t tid,
			trace_tid_last tid t = validate_read_item True (*valid read*)
      /\ ~ trace_no_writes tid t
      -> sto_trace t
      -> sto_trace ((tid, complete_write_item (S (trace_commit_last t))) :: t)

(*| unlock_write_item_step: forall t tid ver,
      trace_tid_last tid t = complete_write_item ver
			/\ ~ trace_no_writes tid t (*locked*)
      -> sto_trace t
      -> sto_trace ((tid, unlock_write_item ver) :: t)*)

(****************************************)
(*| commit_readonly_txn_step: forall t tid,
      (trace_tid_last tid t = validate_read_item True /\ trace_no_writes tid t)(*read only*)
      -> sto_trace t
      -> sto_trace ((tid, commit_txn (trace_commit_last t)) :: t)

| commit_write_txn_step: forall t tid ver,
      trace_tid_last tid t = unlock_write_item ver(*unlock the write*)
      -> sto_trace t
      -> sto_trace ((tid, commit_txn ver) :: t).*)
(****************************************)

(*sequential point*)
| seq_point_step: forall t tid ver,
      (trace_tid_last tid t = validate_read_item True
        /\ trace_no_writes tid t)
      \/ (trace_tid_last tid t = complete_write_item ver
			  /\ ~ trace_no_writes tid t)
      -> trace_no_commits tid t
      -> sto_trace t
      -> sto_trace ((tid, seq_point) :: t)

| commit_txn_step: forall t tid,
      trace_tid_last tid t = seq_point
      -> sto_trace t
      -> sto_trace ((tid, commit_txn (trace_commit_complete_last t)) :: t).
Hint Constructors sto_trace.

Hint Constructors sto_trace.

(*we don't need to rollback, once a transaction aborts, it will 'disappear'. A new transaction will do its work.*)
(*| restart_txn_step: forall t tid newtid,
      trace_tid_last tid t = abort_txn (*we get abort and then restart*)
      -> sto_trace t
    (*our restart is to add back*)
      -> sto_trace ((trace_rollback newtid (trace_commit_last t) (trace_filter_startreadwrite tid t)) ++ t).*)

Example sto_trace_example_rollback:
sto_trace [(3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

assert (trace_commit_complete_last [(3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 1).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step; rewrite H.
unfold trace_tid_last. simpl. auto.
clear H.

apply seq_point_step with (ver := 1).
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes. simpl.
repeat apply Forall_cons; simpl; auto.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto.

assert ((check_version (read_versions_tid 3 ([(3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step.
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes.
repeat apply Forall_cons; simpl; auto. rewrite H.
clear H.

apply try_commit_txn_step with (ver:= 1) (val:= 0).
unfold trace_tid_last. simpl. left. auto.

(*assert (trace_rollback 3 (trace_commit_last [(1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) (trace_filter_startreadwrite 1 [(1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) = [(3, read_item 1); (3, start_txn)]).
unfold trace_rollback. simpl.
unfold trace_commit_last. simpl. auto.

assert ([(3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = [(3, read_item 1); (3, start_txn)] ++ [(1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, unlock_write_item 1); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]). auto.
rewrite H0. rewrite <- H.
apply restart_txn_step. unfold trace_tid_last. simpl. auto. clear H H0.
*)

assert (trace_commit_last [(3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 1).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H.
apply read_item_step with (val:=0) (oldver:=0); rewrite H.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto. clear H.

apply start_txn_step.
unfold trace_tid_last. simpl. auto.

apply abort_txn_step.
unfold trace_tid_last. simpl. auto.

assert ((check_version (read_versions_tid 1 ([(1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = False)).
unfold check_version. simpl. auto.
rewrite <- H.
apply validate_read_item_step.
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes. simpl.
repeat apply Forall_cons; simpl; auto.
clear H.

apply try_commit_txn_step with (ver:= 0) (val:= 4).
unfold trace_tid_last. simpl. auto.

assert (trace_commit_complete_last [ (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 1).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step; rewrite H.
unfold trace_tid_last. simpl. auto.

apply seq_point_step with (ver:=1). right.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H0. inversion H4. inversion H8. inversion H12. inversion H16.
simpl in H19. auto.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto.
(*
apply unlock_write_item_step.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. inversion H7. inversion H11. inversion H15.
simpl in *. auto.
*)
clear H.
assert (trace_commit_last ([(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) = 0).
{ unfold trace_commit_last. simpl. auto. }
assert (1 = S (trace_commit_last [(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])).
{ rewrite H. auto. }
rewrite H0.

apply complete_write_item_step; rewrite <-H0.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H1. inversion H5. inversion H9. inversion H13.
simpl in *. auto.
clear H H0.
assert ((check_version (read_versions_tid 2 ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step.
unfold trace_tid_last. simpl. right. auto. clear H.

apply lock_write_item_step. split.
unfold trace_tid_last. simpl. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. simpl in *. auto.
unfold check_lock_or_unlock. simpl. auto.

apply try_commit_txn_step with (ver := 0) (val:= 4).
unfold trace_tid_last. simpl. auto.

apply write_item_step with (ver:=0) (oldval:=0).
unfold trace_tid_last. simpl. right. left. auto.

assert (trace_commit_last [(2, read_item 0); (2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H.
apply read_item_step with (val:=0) (oldver:=0); rewrite H. clear H.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

assert (trace_commit_last [(2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H0.
apply read_item_step with (val:=0) (oldver:=0); rewrite H0. clear H H0.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

apply start_txn_step. unfold trace_tid_last. auto.
apply start_txn_step. unfold trace_tid_last. auto.

apply empty_step.

Example sto_trace_example_commit:
sto_trace [(2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

assert (trace_commit_complete_last [(2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)] = 1).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step.
unfold trace_tid_last; rewrite H. simpl. auto. rewrite H. clear H.

apply seq_point_step with (ver:= 1).
unfold trace_tid_last. simpl. right. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. inversion H7. inversion H11. inversion H15.
simpl in H18. auto.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto.

assert (trace_commit_last ([(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point);  (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)]) = 0).
{ unfold trace_commit_last. simpl. auto. }
assert (1 = S (trace_commit_last [(2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point);  (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0);(2, read_item 0); (2, start_txn); (1, start_txn)])).
{ rewrite H. auto. }
rewrite H0.

apply complete_write_item_step; rewrite <-H0.
unfold trace_tid_last. simpl. split. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H1. inversion H5. inversion H9. inversion H13.
simpl in *. auto.
clear H H0.
assert ((check_version (read_versions_tid 2 ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step; rewrite H.
unfold trace_tid_last. simpl. right. auto. clear H.

apply lock_write_item_step. split.
unfold trace_tid_last. simpl. auto.
unfold trace_no_writes. simpl.
intuition.
inversion H. inversion H3. simpl in *. auto.
unfold check_lock_or_unlock. simpl. auto.

apply try_commit_txn_step with (ver := 0) (val:= 4).
unfold trace_tid_last. simpl. auto.

apply write_item_step with (ver:=0) (oldval:=0).
unfold trace_tid_last. simpl. right. left. auto.

assert (trace_commit_complete_last [ (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)] = 0).
{ unfold trace_commit_complete_last. simpl. auto. }
rewrite <- H.
apply commit_txn_step; rewrite H.
unfold trace_tid_last. simpl. auto.

apply seq_point_step with (ver:= 0).
unfold trace_tid_last. simpl. left. split. auto.
clear H.
unfold trace_no_writes. simpl.
repeat apply Forall_cons; simpl; auto. clear H.
unfold trace_no_commits. simpl.
repeat apply Forall_cons; simpl; auto. clear H.

assert ((check_version (read_versions_tid 1 ([(1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) (trace_commit_last ([(1, try_commit_txn); (1, read_item 0); (2, read_item 0); (2, start_txn); (1, start_txn)])) = True)).
  {unfold check_version. simpl. auto. }
  rewrite <- H.

apply validate_read_item_step.
unfold trace_tid_last. simpl. left. split. auto.
unfold trace_no_writes.
repeat apply Forall_cons; simpl; auto.
clear H.

apply try_commit_txn_step with (ver:= 0) (val:= 0).
unfold trace_tid_last. simpl. left. auto.

assert (trace_commit_last [(2, read_item 0); (2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H.

apply read_item_step with (val:=0) (oldver:=0); rewrite H. clear H.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

assert (trace_commit_last [(2, start_txn); (1, start_txn)] = 0).
{unfold trace_commit_last; simpl. auto. }
rewrite <- H0.

apply read_item_step with (val:=0) (oldver:=0); rewrite H0. clear H H0.
unfold trace_tid_last. simpl. left. auto.
unfold check_lock_or_unlock. simpl. auto.

apply start_txn_step. unfold trace_tid_last. auto.
apply start_txn_step. unfold trace_tid_last. auto.

apply empty_step.

Definition example_txn:=
[(2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (2, read_item 0); (2, start_txn); (1, commit_txn 0); (1, seq_point); (1, validate_read_item True); (1, try_commit_txn); (1, read_item 0); (1, start_txn)].

Definition example_txn2:=
[(3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

(*
Returns the serialized sequence of transactions in the STO trace based on seq_point of each transaction
The first element (tid) of the sequence is the first transaction that completes in the serial trace
Note that STO-trace is constructed in a reverse order: the first (tid * action) pair is the last operation in the trace
*)

Function seq_list (sto_trace: trace): list nat:=
  match sto_trace with
  | [] => []
  | (tid, seq_point) :: tail => seq_list tail ++ [tid]
  | _ :: tail => seq_list tail
  end.

Eval compute in seq_list example_txn.

Eval compute in seq_list example_txn2.

Lemma seq_list_not_seqpoint tid action t:
  sto_trace ((tid, action) :: t) ->
  action <> seq_point ->
  ~ In tid (seq_list ((tid, action) :: t))
  -> ~ In tid (seq_list t).
Proof.
  intros; destruct action; simpl in *; auto.
Qed.

Lemma seq_list_seqpoint tid action t:
  sto_trace ((tid, action) :: t) ->
  action = seq_point ->
  In tid (seq_list ((tid, action) :: t)).
Proof.
  intros; subst; simpl.
  apply in_or_app. right. simpl. auto.
Qed.

Lemma t_last_seqpoint t tid:
  sto_trace t ->
  trace_tid_last tid t = seq_point
  -> In (tid, seq_point) t.
Proof.
  intros.
  unfold trace_tid_last in H0.
  unfold trace_filter_tid in H0.
  Search (filter).
  inversion H; subst; try discriminate.
  destruct (Nat.eq_dec tid tid0)

Lemma seq_list_commit tid action n t:
  sto_trace ((tid, action) :: t) ->
  action = commit_txn n ->
  In tid (seq_list ((tid, action) :: t)).
Proof.
  intros. subst.
  inversion H.
Admitted.

(*
This function creates a serialized trace.
Just like STO-trace, the order is reversed: that is, the first (tid*action) pair in the serial trace
constructed by this function is the last operation performed in this trace
*)
(*
Function create_serialized_trace (sto_trace: trace) (seqls : list nat): trace:=
  match seqls with
  | [] => []
  | head :: tail
    => create_serialized_trace sto_trace tail ++ trace_filter_tid head sto_trace
  end.
*)
Function create_serialized_trace (sto_trace: trace) (sto_trace_copy: trace): trace:=
  match sto_trace with
  | [] => []
  | (tid, seq_point) :: tail
    => trace_filter_tid tid sto_trace_copy ++ create_serialized_trace tail sto_trace_copy
  | _ :: tail => create_serialized_trace tail sto_trace_copy
  end.

Eval compute in create_serialized_trace example_txn example_txn.

Eval compute in create_serialized_trace example_txn2 example_txn2.

Lemma last_seq_point tid t:
  sto_trace t ->
  trace_tid_last tid t = seq_point
  -> In tid (seq_list t).
Proof.
  intros.
  induction H; simpl; try discriminate.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H3 in H4. simpl in H4. inversion H4.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H4.
  apply IHsto_trace in H4. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H3 in H4. simpl in H4. inversion H4.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H4.
  apply IHsto_trace in H4. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
  admit.
  unfold trace_tid_last in H0. inversion H0.
  destruct (Nat.eq_dec tid tid0); subst. assert (true = (tid0 =? tid0)).
  apply beq_nat_refl. rewrite <- H2 in H3. simpl in H3. inversion H3.
  apply not_eq_sym in n. apply Nat.eqb_neq in n. rewrite n in H3.
  apply IHsto_trace in H3. auto.
Admitted.

Lemma seq_list_action tid action n t:
  sto_trace ((tid, action) :: t) ->
  action = seq_point \/ action = commit_txn n
  <-> In tid (seq_list ((tid, action) :: t)).
Proof.
  intros. split. intros. destruct H0.
  rewrite H0. simpl. apply in_or_app. right. simpl. auto.
  rewrite H0 in *.
  inversion H.
  simpl.
  apply last_seq_point; auto.
  admit.
Admitted.

Lemma seq_list_action_neg tid action n t:
  sto_trace ((tid, action) :: t) ->
  action <> seq_point /\ action <> commit_txn n
  <-> ~ In tid (seq_list ((tid, action) :: t)).
Proof.
  intros. split.
  intros.
  intuition.
  apply seq_list_action with (n := n) in H .
  destruct H. apply H0 in H1. destruct H1; auto.
  intros.
  intuition.
  apply seq_list_action with (n := n) in H .
  destruct H.
  assert (action = seq_point \/ action = commit_txn n). { left. auto. }
  apply H in H3. auto.
  apply seq_list_action with (n := n) in H .
  destruct H.
  assert (action = seq_point \/ action = commit_txn n). { right. auto. }
  apply H in H3. auto.
Qed.

Lemma serial_action tid action n t:
  sto_trace ((tid, action) :: t) ->
  action <> seq_point /\ action <> commit_txn n
  -> create_serialized_trace ((tid, action) :: t) (seq_list ((tid, action) :: t)) =
     create_serialized_trace t (seq_list t).
Proof.
  intros.
  inversion H; subst.
  assert (start_txn <> seq_point /\ start_txn <> commit_txn n
  -> ~ In tid (seq_list ((tid, start_txn) :: t))).
  { apply seq_list_action_neg. auto. }
  assert (~ In tid (seq_list ((tid, start_txn) :: t))).
  { apply H1 in H0. auto. }
  simpl.
  remember (seq_list t) as ts.
  induction ts.
  simpl. auto.
  simpl.
(*  apply seq_list_in in H2.
  rewrite <- Heqts in H2.
  apply not_in_cons in H2. destruct_pairs.
  assert ((tid =? a) = false). { apply Nat.eqb_neq. auto. }
  rewrite H7.

  destruct (Nat.eq_dec tid a).
  assert (true = (tid =? a)). { apply Nat.eqb_eq in e. auto. }
  rewrite <- H1.
*)

Admitted.

(*
This lemma proves that the seq_point of each transaction in a STO-trace determines its serialized order in the serial trace
*)

Lemma seq_list_equal trace:
  sto_trace trace ->
  seq_list (create_serialized_trace (trace) (seq_list trace)) = seq_list trace.
Proof.
  intros. simpl.
  induction H.
  - simpl. auto.
  - simpl. assert (trace_tid_last tid0 t <> seq_point).
    rewrite H. intuition. inversion H1.

Admitted.

Lemma seq_list_equal_old tid action trace:
  sto_trace trace ->
  (action = seq_point <->
  seq_list (create_serialized_trace ((tid, action) :: trace) (seq_list ((tid, action) :: trace))) = seq_list trace ++ [tid]).
Proof.
  split.
  intros. subst.
  simpl.
  -
Admitted.

(*
This lemma proves that the sequences of other actions in each transaction in a STO-trace does not
affect its order in the serial trace
*)
Lemma seq_list_equal2 tid action trace:
  ~(action = seq_point) ->
  seq_list (create_serialized_trace ((tid, action) :: trace) (seq_list trace)) = seq_list trace.
Proof.
Admitted.

(*
Check whether an element a is in the list l
*)
Fixpoint In_bool (a:nat) (l:list nat) : bool :=
  match l with
    | [] => false
    | b :: m => (b =? a) || In_bool a m
  end.

(*
The function checks if a trace is a serial trace by making sure that
tid is only increaing as we traverse the trace
In this function, we assume that the trace is in the correct order.
That is, the first (tid*action) in the trace is actually the first one that gets to be executed
*)
Function check_is_serial_trace (tr: trace) (tidls: list nat): Prop :=
  match tr with
  | [] => True
  | (tid, _) :: tail => if (negb (tid =? (hd 0 tidls))) && (In_bool tid tidls)
                          then False
                          else check_is_serial_trace tail (tid :: tidls)
  end.

Definition is_serial_trace tr: Prop :=
  check_is_serial_trace tr [].

Eval compute in is_serial_trace [(2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (2, read_item 0); (2, start_txn); (3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn)].

Eval compute in is_serial_trace [(3, commit_txn 1); (3, seq_point); (3, validate_read_item True); (3, try_commit_txn); (3, read_item 1); (3, start_txn); (1, abort_txn); (1, validate_read_item False); (1, try_commit_txn); (2, commit_txn 1); (2, seq_point); (2, complete_write_item 1); (2, validate_read_item True); (2, lock_write_item); (2, try_commit_txn); (2, write_item 4); (1, read_item 0); (2, read_item 0);  (2, start_txn); (1, start_txn)].

Eval compute in is_serial_trace example_txn.

Lemma is_serial trace:
  is_serial_trace (create_serialized_trace trace (seq_list trace)).
Proof.
  unfold is_serial_trace.
  functional induction create_serialized_trace trace (seq_list trace).
  simpl. auto.

(*
This function executes STO trace in the reverse order
The goal is to record all read and write actions of all *committed* transactions
*)
Function exec (sto_trace: trace) (commit_tid: list nat) : list (tid * action) :=
  match sto_trace with
  | [] => []
  | (tid, action) :: tail => if (In_bool tid commit_tid)
            then match action with
                | read_item _ => (tid, action) :: exec tail commit_tid
                | write_item _ => (tid, action) :: exec tail commit_tid
                | _ => exec tail commit_tid
                 end
            else exec tail commit_tid
  end.

Eval compute in exec example_txn (seq_list example_txn).

(*
This function returns all values that is written in a trace to a memory location
*)
Function tid_write_value (trace: trace) : list value :=
  match trace with
  | [] => []
  | (_, write_item val) :: tail => val :: tid_write_value tail
  | _ :: tail => tid_write_value tail
  end.

(*
This function returns a list of pair that records write values of each tids in the trace
the first element in a pair is tid
the second element is all the write values written by the transaction with the id tid
*)
Function get_write_value (trace: trace) (tids: list nat) : list (nat * (list value)):=
  match tids with
  | [] => []
  | head :: tail => (head, tid_write_value (trace_filter_tid head trace)) :: get_write_value trace tail
  end.

Definition get_write_value_out (sto_trace: trace) : list (nat * (list value)) :=
  get_write_value sto_trace (seq_list sto_trace).

Eval compute in get_write_value_out example_txn.

(*
This function compares values in two lists one by one
The value at each position in one list should be the same as that in the other list
*)
Function compare_value (ls1: list value) (ls2: list value): bool:=
  match ls1, ls2 with
  | [], [] => true
  | _ , [] => false
  | [], _ => false
  | h1::t1, h2::t2 => if h1=?h2 then compare_value t1 t2 else false
  end.

(*
We compare writes of two traces in this function
If they have the same write sequence, then the function will return True
****************************************************
We assume that two traces have the same tids in the same sequence
Should we actually add tid1 =? tid2 in the code to remove this assumption?
****************************************************
*)
Function compare_write_list (ls1: list (nat * (list value))) (ls2:list (nat * (list value))): Prop :=
  match ls1, ls2 with
  | [], [] => True
  | _ , [] => False
  | [], _ => False
  | (tid1, ver1)::t1, (tid2, ver2)::t2
        => if (tid1 =? tid2 ) && (compare_value ver1 ver2) then compare_write_list t1 t2
            else False
  end.

Definition write_synchronization trace1 trace2: Prop:=
  compare_write_list (get_write_value_out trace1) (get_write_value_out trace2).

(*
The function returns the last write value of a STO-trace
*)
Definition last_write_value trace: nat:=
  trace_write_last (exec trace (seq_list trace)).

Eval compute in last_write_value example_txn.
(*
Definition write_synchronization trace1 trace2: Prop:=
  if (last_write_value trace1) =? (last_write_value trace2)
  then True
  else False.
*)
Eval compute in write_synchronization example_txn (create_serialized_trace example_txn (seq_list example_txn)).

Lemma serialized_trace_app_no_sp:
  forall t tid a, sto_trace t -> a <> seq_point ->
    create_serialized_trace t (seq_list t) =
    create_serialized_trace ((tid, a)::t) (seq_list ((tid, a)::t)).
Proof.
  intros.
  assert (seq_list t = seq_list ((tid0, a) :: t)) by (induction a; simpl; intuition).
  rewrite <- H1.
  assert (~ In tid0 (seq_list t)). {
  inversion H. Focus 2.
  remember (seq_list t) as splist. clear H1. clear Heqsplist.
  functional induction (create_serialized_trace ((tid0, a) :: t) splist).
  -- auto.
  -- simpl. assert (tid0 =? head = false). admit.
     rewrite H1. admit.

(*
A STO-trace and its serial trace should have the same writes.
**************************************************
Should we prove that create_serialized_trace function actually prove the correct serial trace of the
STO-trace
**************************************************
*)
 Lemma write_equivalence trace:
  sto_trace trace ->
  let serialized_trace := create_serialized_trace trace (seq_list trace) in
  write_synchronization trace serialized_trace.

Proof.
  intros.
  induction H.
  - unfold write_synchronization. unfold get_write_value_out. simpl. auto.
  - unfold write_synchronization.
    unfold write_synchronization in IHsto_trace.
    assert (get_write_value_out t = get_write_value_out ((tid0, start_txn) :: t)).
    { unfold get_write_value_out. simpl. clear H. clear serialized_trace.
      unfold get_write_value_out in IHsto_trace. simpl in IHsto_trace.
      assert (seq_list (create_serialized_trace t (seq_list t)) = seq_list t). admit.
      rewrite H in IHsto_trace. clear H. remember (seq_list t) as tids. clear Heqtids.
      functional induction (get_write_value t tids).
      -- simpl. auto.
      --
 simpl. destruct (Nat.eq_dec tid0 head).
         --- admit. (* This case is not possible. skip for now *)
         --- apply Nat.eqb_neq in n. rewrite n.
             assert (get_write_value t tail = get_write_value ((tid0, start_txn) :: t) tail).
             { remember ((head, tid_write_value (trace_filter_tid head t))
                 :: get_write_value t tail) as ls1.
               remember (get_write_value (create_serialized_trace t (head :: tail))
                   (head :: tail)) as ls2.
               functional induction (compare_write_list ls1 ls2).
                ---- inversion Heqls2.
                ---- discriminate.
                ---- discriminate.
                ---- assert (t1 <> (head, tid_write_value (trace_filter_tid head t))
         :: get_write_value t tail). admit. admit.
                ---- auto. intuition. } admit. }
      rewrite serialized_trace.

assert (create_serialized_trace t (head :: tail) == create_serialized_trace t tail).

 simpl in *.

  - unfold write_synchronization. unfold get_write_value_out.
    assert (seq_list (create_serialized_trace ((tid0, start_txn) :: t) (seq_list ((tid0, start_txn) :: t))) = seq_list t).
    {
      remember (start_txn) as action.
      apply seq_list_equal2. rewrite Heqaction. intuition. inversion H2.
    }

  rewrite H3.
Admitted.*)

(*
Now we proceed to the read part of the proof.
*)

(*
This function returns the version numbers of all the reads in a trace
*)
Function tid_read_version (trace: trace) : list version :=
  match trace with
  | [] => []
  | (_, read_item ver) :: tail => ver :: tid_read_version tail
  | _ :: tail => tid_read_version tail
  end.

(*
This function groups all versions of reads of a transaction in a trace.
This returns a list of pairs
The first element of a pair is the tid
The second element is a list of all versions of the reads from the transaction tid
*)
Function get_read_version (trace: trace) (tids: list nat) : list (nat * (list version)):=
  match tids with
  | [] => []
  | head :: tail => (head, tid_read_version (trace_filter_tid head trace)) :: get_read_version trace tail
  end.

Definition get_read_version_out (trace: trace) : list (nat * (list version)) :=
  get_read_version trace (seq_list trace).

Eval compute in get_read_version_out example_txn.

Eval compute in get_read_version_out example_txn2.

(*
This function compares all read versions of two list
This is the same as compare all write in previous functions
*)
Function compare_version (ls1: list version) (ls2: list version): bool:=
  match ls1, ls2 with
  | [], [] => true
  | _ , [] => false
  | [], _ => false
  | h1::t1, h2::t2 => if h1=?h2 then compare_version t1 t2 else false
  end.

Function compare_read_list (ls1: list (nat * (list version))) (ls2:list (nat * (list version))): Prop :=
  match ls1, ls2 with
  | [], [] => True
  | _ , [] => False
  | [], _ => False
  | (tid1, ver1)::t1, (tid2, ver2)::t2
        => if (tid1 =? tid2 ) && (compare_version ver1 ver2) then compare_read_list t1 t2
            else False
  end.

Definition read_synchronization trace1 trace2: Prop:=
  compare_read_list (get_read_version_out trace1) (get_read_version_out trace2).

Eval compute in read_synchronization example_txn (create_serialized_trace example_txn (seq_list example_txn)).

Eval compute in compare_read_list [(1, [0;0]); (2, [1;1])] [(1, [0]);(2, [1;1])].

(*
A STO-trace and its serial trace should have the same reads.
*)
Lemma read_consistency trace:
  sto_trace trace
  -> sto_trace (create_serialized_trace trace (seq_list trace))
  -> is_serial_trace (create_serialized_trace trace (seq_list trace))
  -> read_synchronization trace (create_serialized_trace trace (seq_list trace)).
Admitted.

(*
Two traces can be considered equivalent in execution if they produce the same reads and writes
*)
Definition Exec_Equivalence trace1 trace2: Prop:=
  write_synchronization trace1 trace2 /\ read_synchronization trace1 trace2.

Eval compute in Exec_Equivalence example_txn (create_serialized_trace example_txn (seq_list example_txn)).

(*
The capstone theorem: prove serializability of a sto-trace
*)
Theorem txn_equal t:
  sto_trace t
  -> exists t', sto_trace t'
  -> is_serial_trace t'
  -> Exec_Equivalence t t'.
Proof.
  exists (create_serialized_trace t (seq_list t)).
  intros.
  unfold Exec_Equivalence. split.
  apply write_consistency; auto.
  apply read_consistency; auto.
Qed.


Require Export D.

(** **** Exercise: 1 star (update_neq)  *)
Theorem update_neq : forall x2 x1 n st,
  x2 <> x1 ->
  (update st x2 n) x1 = (st x1).
Proof.
  intros. unfold update. apply neq_id. assumption.
Qed.


Require Export preambule_nat preambule_liste.

Import ListNotations.

(*
 * Préambule.
 * P1. listes
 * Théorie catégorique des préfixes et des suffixes
 * Elle vise à définir les [pré|suf]fixes d'une concaténation facilement.
 * Préfixe, suffixe : deux transformations naturelles du foncteur Liste vers le
 * foncteur monadique (Curseur -> Liste _ * Curseur) où Curseur
 * représente l'ensemble des intervalles [0, n[ ou [n, +infini[ suivant les cas.
 *)

(* Préambule - sur les monades *)

Definition extensionMonadiqueFonctionUnaire{A B : Type}
           (M : Type -> Type)
           (unite : forall {X}, X -> M X)
           (liaison : forall {X Y}, M X -> (X -> M Y) -> M Y)
           (f : A -> B)
  : M A -> M B
  := fun m  =>
       liaison
         m
         (fun a => unite (f a) ).

Definition extensionMonadiqueFonctionBinaire{A B C : Type}
           (M : Type -> Type)
           (unite : forall {X}, X -> M X)
           (liaison : forall {X Y}, M X -> (X -> M Y) -> M Y)
           (f : A -> B -> C)
  : M A -> M B -> M C
  := fun m1 m2 =>
       liaison
         m1
         (fun a =>
           liaison
             m2
             (fun b => unite (f a b) )).

(* Deux monades : Liste et Reglage *)

(* Liste ( := list) est un foncteur. *)

Definition applicationListe{A B : Type} : (* map *)
  (A -> B) -> list A -> list B.
  fix REC 2.
  intros f l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    exact (f tl :: REC f rl).
  }
Defined.

(* Liste est une monade. *)

Definition uniteListe{A : Type} (* unit *)
  : A -> list A
  := fun a => [a].

Definition liaisonListe{A B : Type} (* bind *)
  : list A -> (A -> list B) -> list B.
  fix REC 1.
  intros l calculParam.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    exact (calculParam tl ++ REC rl calculParam).
  }
Defined.

(* La monade d'état *)

Definition Etat(E T : Type)
  : Type
  := (E -> T * E). (* E état, T observé *)

(* Pour tout E, (Etat E) est un foncteur. TODO propriétés *)

Definition applicationEtat{E A B : Type} : (* map *)
  (A -> B) -> Etat E A -> Etat E B.
  intros f ta.
  intro e.
  exact (f (fst (ta e)), snd (ta e)).
Defined.

(* Etat est une monade. TODO propriétés *)

Definition uniteEtat{E A : Type} (* unit *)
  : A -> Etat E A.
  intros a e.
  exact (a, e).
Defined.

Print uniteEtat.

Definition liaisonEtat{E A B : Type} (* bind *)
  : Etat E A -> (A -> Etat E B) -> Etat E B.
  intros ta calculParam e.
  exact(calculParam (fst (ta e)) (snd (ta e))).
Defined.

(* Le réglage, instance de l'état *)

Definition Reglage(V T : Type)  (* Tuner *)
  : Type
  := Etat V (list T). (* V variant, liste observée de T  *)

(* Pour tout V, (Reglage V) est un foncteur. TODO propriétés *)

Definition applicationReglage{V A B : Type} : (* map *)
  (A -> B) -> Reglage V A -> Reglage V B.
  intros f ra.
  intro v.
  exact (applicationListe f (fst (ra v)), snd (ra v)).
Defined.

Inductive Curseur (* Cursor *)
  : Type
  :=
  | VAL : forall n : nat, Curseur.

Definition valeurCurseur(c : Curseur) : nat.
  destruct c as [n].
  exact n.
Defined.

Inductive Fenetre (* Window *)
  : Type
  :=
  | PLAGE : forall n d : nat, Fenetre.

Definition plageFenetre(f : Fenetre) : nat * nat.
  destruct f as [n d].
  exact (n, d).
Defined.

(* Prefixe est une transformation naturelle du foncteur Liste vers le foncteur (Reglage Curseur). *)
(* TODO propriétés *)
Definition prefixeRC{T : Type}
  : list T -> Reglage Curseur T.
  fix REC 1.
  intros l c.
  destruct l as [ | tl rl].
  {
    exact ([], c).
  }
  {
    destruct c as [[ | pn]].
    {
      exact([], VAL 0).
    }
    {
      exact (tl :: fst (REC rl (VAL pn)), snd (REC rl (VAL pn))).
    }
  }
Defined.

(* Suffixe est une transformation naturelle du foncteur Liste vers le foncteur ReglageCurseur. *)
(* TODO propriétés *)

Definition suffixeRC{T : Type}
  : list T -> Reglage Curseur T.
  fix REC 1.
  intros l c.
  destruct l as [ | tl rl].
  {
    exact ([], c).
  }
  {
    destruct c as [[ | pn]].
    {
      exact(tl :: rl, VAL 0).
    }
    {
      exact (REC rl (VAL pn)).
    }
  }
Defined.

Definition suffixe{T : Type}
  : nat -> list T -> list T.
  fix REC 2.
  intros n l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    destruct n as [ | pn].
    {
      exact(tl :: rl).
    }
    {
      exact (REC pn rl).
    }
  }
Defined.

Definition prefixe{T : Type}
  : nat -> list T -> list T.
  fix REC 2.
  intros n l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    destruct n as [ | pn].
    {
      exact [].
    }
    {
      exact (tl :: (REC pn rl)).
    }
  }
Defined.

(* Sous-liste *)

Definition sousListeRF{T : Type}
  : list T -> Reglage Fenetre T.
  fix REC 1.
  intros l v.
  destruct l as [ | tl rl].
  {
    exact ([], v).
  }
  {
    destruct v as [n d].
    destruct n as [ | pn].
    {
      destruct d as [ | pd].
      {
        exact ([], PLAGE 0 0).
      }
      {
        exact (tl :: (fst (REC rl (PLAGE 0 pd))), snd (REC rl (PLAGE 0 pd))).
      }
    }
    {
      exact (REC rl (PLAGE pn d)).
    }
  }
Defined.

(* sous liste n d l := l[n:n+d[ *)
Definition sousListe{T : Type}
  : nat -> nat -> list T -> list T.
  fix REC 3.
  intros n d l.
  destruct l as [ | tl rl].
  {
    exact [].
  }
  {
    destruct n as [ | pn].
    {
      destruct d as [ | pd].
      {
        exact [].
      }
      {
        exact (tl :: (REC 0 pd rl)).
      }
    }
    {
      exact (REC pn d rl).
    }
  }
Defined.

Definition valeur{T : Type}(n : nat)(l : list T)
  : list T
  := sousListe n 1 l.

(* concaténation monadique *)

Definition concatenationMonadiqueR{V T : Type}
  : Reglage V T -> Reglage V T -> Reglage V T
  := extensionMonadiqueFonctionBinaire
       (@Etat V)
       (@uniteEtat V)
       (@liaisonEtat V)
       (@app T).

(* Voie directe plus simple *)
Definition concatenationR{V T : Type}
  : Reglage V T -> Reglage V T -> Reglage V T.
  intros r1 r2.
  intro v.
  exact (
      fst (r1 v) ++ fst (r2 (snd(r1 v)))
      ,
      snd (r2 (snd(r1 v)))
      ).
Defined.


(*
  Copyright 2022 ZhengPu Shi
  This file is part of CoqExt. It is distributed under the MIT
  "expat license". You should have recieved a LICENSE file with it.

  purpose   : extension for Coq.Reals.
  author    : ZhengPu Shi
  date      : 2021.05

  remark    :
  1. possible reason of "field" failure
    a. notation "/", need unfold Rdiv first.
    b. unknown variable name, need be rewrite first.
  2. why need this library?
    (1). lots of properties are lack in standard library.
    (2). more automation, especially inequality.
    (3). We want to solve any problem of equality or inequality in one step.
  3. why auto fail? and how to better naming a term?
    (1). use two lemmas like A -> B and B -> A instead of A <-> B
    (2). x * x and x² are mixed, and x² is defined as x * x, and Coq Standard
      Library prefer x², so we'd better choose x². But, notice that we should
      rewrie x² to x * x before using ring or field, it's a bit annoying.
    (3). 1 and R1 are mixed, and 1 is (IZR (Zpos xH)), and will be reduced to R1
      finally, and Coq Standard Library prefer 1, so we choose 1 as well.
    (4). x - y and x + (-y) is same, but we prefer x - y.
    (5). x / y and x * (-y), we prefer x / y as well.

  4. Coq's support for automatic proofs of equalities and inequalities.
     ref：https://coq.inria.fr/distrib/current/refman/addendum/micromega.html
(1). Micromega: a solver to solving arithmetic goals by ordered ring structure.
(2). Psatz: a solver to solvign arithmetic golas on Q,R,Z,nat, and N.
lia: linear, for integer (including Z,nat, and N)
nia: non-linear, for integer
lqa: linear, for rational number Q.
lra: linear, for real number R and rational number Q.
nra: non-linear, for real number and rational number.
psatz D n: non-linear
  here, D is Z/Q/R, n is an optional integer representing search depth.
(3). What's the ability of these solvers?
  It can solve the propositional formulas which its parameters are in the
  field D∈{Z,Q,R}. The formulas are belows:
        p ::= c | x | -p | p+p | p-p | p*p | p^n
        A ::= p=p | p>p | p<p | p<=p | p>=p
        F ::= A | P | True | False | F/\F | F\/F | F<->F | F->F | ~F | F=F
  Here,
    c is constant in D,
    x is variable in D,
    -,+,* is subtract,addition,multiplication seperately,
    p^n is power of nat n,
    F are interpreted as Prop or bool.
    (a) If F is interpreted as bool, the corresponding operaters are:
           &&,||,eqb,implb,negb.
        And if D is Z, then the relations are:
            Z.eqb,Z.gtb,Z.ltb,Z.geb,Z.leb
        And if D is Q, then the equal realtion is Qeq (==), not eq (=).
    (b) the range of constant c,
        for Z and Q, c is all possible value could be get;
        for R, c is the expression below:
            c ::= R0 | R1 | IZR z | Q2R q
                  | Rmult c c | Rplus c c | Rminus c c| Rdiv c c | Rinv c
 *)

Require Export BasicConfig.
Require Import HierarchySetoid.

Require Export ZExt.
Require Export Reals.
Open Scope R_scope.

Require Export Psatz.
Require Export Lra.

(* ######################################################################### *)
(** * Config the usage of Coq-Standard-Library Reals: Hints, Opaque, auto *)

(** Config hint db for autounfold *)
Global Hint Unfold
  Rminus        (* a - b = a + - b *)
  Rdiv          (* a / b = a * / b *)
  Rsqr          (* r² = r * r *)
  : R.

(** Config hint db for autorewrite, for rewriting of equations *)
#[export] Hint Rewrite
  (* Abs *)
  Rabs_R0             (* Rabs 0 = 0 *)
  Rabs_Ropp           (* Rabs (-x) = Rabs x *)
  Rabs_Rabsolu        (* Rabs (Rabs x) = Rabs x *)

  (* + *)
  Rplus_0_l           (* 0 + r = r *)
  Rplus_0_r           (* r + 0 = r *)

  (* -a *)
  Ropp_0              (* - 0 = 0 *)
  Rminus_0_r          (* r - 0 = r *)
  Ropp_involutive     (* - - r = r *)
  Rplus_opp_r         (* r + - r = 0 *)
  Rplus_opp_l         (* - r + r = 0 *)
  Rminus_eq_0         (* r - r = 0 *)

  (* x *)
  Rsqr_0              (* 0² = 0 *)
  Rsqr_1              (* 1² = 1 *)
  Rmult_0_l           (* 0 * r = 0 *)
  Rmult_0_r           (* r * 0 = 0 *)
  Rmult_1_l           (* 1 * r = r *)
  Rmult_1_r           (* r * 1 = r *)
(*   Ropp_mult_distr_r_reverse     (* r1 * - r2 = - (r1 * r2) *) *)
(*   Ropp_mult_distr_l_reverse     (* - r1 * r2 = - (r1 * r2) *) *)

  (* pow *)
  pow1                (* 1 ^ n = 1 *)
  pow_O               (* x ^ 0 = 1 *)
  pow_1               (* x ^ 1 = x *)

  (* Rpower *)
  Rpower_O            (* power x 0 = 1 *)
  Rpower_1            (* power x 1 = x *)

  (* sqr *)
  Rsqr_mult           (* (x * y)² = x² * y² *)

  (* sqrt *)
  sqrt_Rsqr_abs       (* (sqrt x²) = Rabs x *)
  (* Rsqr_sqrt           (* 0 <= x -> (sqrt x)² = x *) *)
  (* sqrt_Rsqr           (* 0 <= x -> sqrt x² = x *) *)
  sqrt_0              (* sqrt 0 = 0 *)
  : R.

(** Config hint db for auto，for solving equalities or inequalities *)
Global Hint Resolve
  (* equalities *)
  eq_sym              (* a = b -> b = a *)
  sqrt_0              (* sqrt 0 = 0 *)
  Rsqr_eq_0           (* x² = 0 -> x = 0 *)
(*   sqrt_sqrt           (* 0 <= x -> sqrt x * sqrt x = x *) *)
  Rsqr_sqrt           (* 0 <= x -> (sqrt x)² = x *)
  sqrt_Rsqr           (* 0 <= x -> sqrt x² = x *)
  sin2_cos2           (* (sin x)² + (cos x)² = 1 *)

  (* general inequalities *)
  Rlt_0_1             (* 0 < 1 *)
  PI_RGT_0            (* PI > 0 *)
  Rabs_pos            (* 0 <= Rabs x *)
  Rabs_no_R0          (* r <> 0 -> Rabs r <> 0 *)
  sqrt_pos            (* 0 <= sqrt x *)
  Rle_0_sqr           (* 0 <= r² *)
(*   Rsqr_inj            (* 0 <= x -> 0 <= y -> x² = y² -> x = y *) *)
  Rinv_0_lt_compat    (* 0 < r -> 0 < / r *)

  (* inequalities such as "0 <= r1 + r2" *)
  Rplus_le_le_0_compat  (* 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2 *)
  Rplus_lt_le_0_compat  (* 0 < r1 -> 0 <= r2 -> 0 < r1 + r2 *)
  Rplus_le_lt_0_compat  (* 0 <= r1 -> 0 < r2 -> 0 < r1 + r2 *)
  Rplus_lt_0_compat   (* 0 < r1 -> 0 < r2 -> 0 < r1 + r2 *)

  (* inequalities such as "0 <= r1 * r2" *)
  Rmult_lt_0_compat   (* 0 < r1 -> 0 < r2 -> 0 < r1 * r2 *)
  Rle_0_sqr           (* 0 <= x² *)
  Rsqr_pos_lt         (* x <> 0 -> 0 < x² *)

  (* inequalities such as "r1 <= r2" *)
  Rlt_gt              (* r1 < r2 -> r2 > r1 *)  (* THIS IS ALWAYS NEED! *)
  Rgt_lt              (* r1 > r2 -> r2 < r1 *)  (* THIS ONE, slow but useful *)
  Rge_le              (* r1 >= r2 -> r2 <= r1 *)
  Rle_ge              (* r1 <= r2 -> r2 >= r1 *)
  Rlt_le              (* r1 < r2 -> r1 <= r2 *)
  Rsqr_pos_lt         (* x <> 0 -> 0 < x² *)

  (* inequalities such as "r1 <> r2" *)
  Rgt_not_eq          (* r1 > r2 -> r1 <> r2 *)
  Rlt_not_eq          (* r1 < r2 -> r1 <> r2 *)

  (* inequalities containing "sqrt" *)
  sqrt_lt_R0          (* 0 < x -> 0 < sqrt x *)
  sqrt_inj            (* 0 <= x -> 0 <= y -> sqrt x = sqrt y -> x = y *)
  : R.

(** Control Opaque / Transparent of the definitions *)
Global Opaque
  PI
  sqrt
  Rpower
  sin
  cos
  tan
  asin
  atan
  acos
  ln
.

Section TEST_psatz.
  Goal forall x y, x ^ 2 + y * y >= x * y.
    intros.
    (* psatz R 1. (* require external tool CSDP *) *)
    nra.
  Qed.

End TEST_psatz.

(** arithmetric on reals : lra + nra *)
Ltac ra :=
  intros; unfold Rsqr in *; try lra; try nra; auto with R.

(* ######################################################################### *)
(** * Suplymentary properties about "real number R" *)

(* ======================================================================= *)
(** ** Rsqr, Rpow2, x*x *)

(** There are several ways to represent square:
    x * x，it is a notation for "Rmult x x"
    x ^ 2, it is a notation for "pow x 2"
    x²   , it is a notation for "Rsqr x", which defined as x * x.
    In Coq-std-lib, I should use which one to representing square? What's the
    famous way? After the search, I find that:
        x * x，9
        x ^ 2, 14
        x², 100
    So, we should mainly use x², and other ways should be converted to this way,
    and the lost lemmas should be given manually.

    Another question, the lra tactic is working well on "x * x" and "pow x 2",
    but not working on "x²".
    So, we use "try (unfold Rsqr in *; lra)" insead of "try lra".
    In addition, using the tactics ring and field also need to unfold Rsqr.

    In conclusion, there are two cases:
    1. when use "ring,field,lra", write: unfold Rsqr in *; ring.
    2. other cases, write: autorewrit with R; auto with R.
 *)

(** We always prefer x², an exception is when using ring or field tactic. *)
Lemma xx_Rsqr x : x * x = x².
Proof.
  auto.
Qed.
#[export] Hint Rewrite xx_Rsqr : R.

(** r ^ 2 = r² *)
Lemma Rpow2_Rsqr r : r ^ 2 = r².
Proof.
  ra.
Qed.
#[export] Hint Rewrite Rpow2_Rsqr : R.

(* ======================================================================= *)
(** ** R0 and 0 *)

(* (** We always prefer 0 *) *)
(* Lemma R0_eq_0 : R0 = 0. *)
(* Proof. *)
(*   auto. *)
(* Qed. *)
(* #[export] Hint Rewrite R0_eq_0 : R. *)

Lemma Rsqr_R0 : R0² = R0.
Proof.
  ra.
Qed.
#[export] Hint Rewrite Rsqr_R0 : R.
Global Hint Resolve Rsqr_R0 : R.

(* ======================================================================= *)
(** ** R1 and 1 *)

(* (** We always prefer 1 *) *)
(* Lemma R1_eq_1 : R1 = 1. *)
(* Proof. *)
(*   auto. *)
(* Qed. *)
(* #[export] Hint Rewrite R1_eq_1 : R. *)

Lemma Rsqr_1 : 1² = 1.
Proof.
  ra.
Qed.
#[export] Hint Rewrite Rsqr_1 : R.
Global Hint Resolve Rsqr_1 : R.

(** /1 = 1 *)
#[export] Hint Rewrite Rinv_1 : R.
Global Hint Resolve Rinv_1 : R.

Lemma zero_le_1 : 0 <= 1.
Proof.
  auto with R.
Qed.
Global Hint Resolve zero_le_1 : R.

Lemma zero_neq_1 : 0 <> 1.
Proof.
  auto with R.
Qed.
Global Hint Resolve zero_neq_1 : R.

Module TEST_R1_and_1.
  Goal 1 = R1. auto with R. Qed.
  Goal R1² = 1. auto with R. Qed.
  Goal 1² = R1. auto with R. Qed.
  Goal /R1 = R1. auto with R. Qed.
  Goal /R1 = 1. auto with R. Qed.
  Goal /1 = R1. auto with R. Qed.
  Goal 0 <= R1. auto with R. Qed.
End TEST_R1_and_1.

(* ======================================================================= *)
(** ** About "-a" and "a-b" *)

Lemma Rsub_opp r1 r2 : r1 - (- r2) = r1 + r2.
Proof.
  ring.
Qed.
#[export] Hint Rewrite Rsub_opp : R.           (* r1 - (- r2) = r1 + r2 *)

(* ======================================================================= *)
(** ** About "square" *)

Lemma Rle_0_xx : forall r, 0 <= r * r.
Proof.
  ra.
Qed.

(** The sum of squares of two real numbers is non-negative *)
Lemma Rplus_sqr_ge0 : forall r1 r2 : R, 0 <= r1² + r2².
Proof.
  ra.
Qed.

(** The sum of squares of two real numbers is non-negative *)
Lemma Rplus_sqr_ge0_form2 : forall r1 r2 : R, 0 <= r1 * r1 + r2 * r2.
Proof.
  ra.
Qed.

(** The sum of squares of two real numbers is positive, iff they are not both 0 *)
Lemma Rplus_sqr_gt0 : forall r1 r2 : R, 0 < r1² + r2² <-> (r1 <> 0 \/ r2 <> 0).
Proof.
  ra.
Qed.

Lemma Rplus_sqr_gt0_l : forall r1 r2, r1 <> 0 -> 0 < r1² + r2².
Proof. ra. Qed.

Lemma Rplus_sqr_gt0_r : forall r1 r2, r2 <> 0 -> 0 < r1² + r2².
Proof. ra. Qed.

(** If the sum of squares of two real numbers is zero, then the second number is 0 *)
Lemma Rplus_sqr_eq_0_r : forall r1 r2, r1² + r2² = 0 -> r2 = 0.
Proof.
  ra.
Qed.

(** Real number inequality: 2 * a * b <= a² + b² *)
Lemma R_neq1 : forall r1 r2 : R, 2 * r1 * r2 <= r1² + r2².
Proof.
  intros. apply Rge_le. apply Rminus_ge.
  (* (a-b)² = a² + b² - 2ab *)
  rewrite <- Rsqr_minus. auto with R.
Qed.

(** r1² + r2² = 0 <-> r1 = 0 /\ r2 = 0 *)
Lemma Rplus_sqr_eq0_iff : forall r1 r2, r1² + r2² = 0 <-> r1 = 0 /\ r2 = 0.
Proof.
  ra.
Qed.

(** r1² + r2² = 0 <-> r1 = 0 /\ r2 = 0 *)
Lemma Rplus_sqr_eq0_iff_form2 : forall r1 r2, r1 * r1 + r2 * r2 = 0 <-> r1 = 0 /\ r2 = 0.
Proof.
  ra.
Qed.

(** r1 <> 0 \/ r2 <> 0 <-> r1² + r2² <> 0 *)
Lemma Rplus_sqr_neq0_iff2 : forall r1 r2, r1 <> 0 \/ r2 <> 0 <-> r1² + r2² <> 0.
Proof. ra. Qed.

(** r1*r1 + r2*r2 <> 0 -> 0 < r1*r1 + r2*r2 *)
Lemma Rplus_sqr_sqr_neq0_iff_Rplus_sqr_sqr_gt0 : forall r1 r2 : R,
  r1² + r2² <> 0 <-> 0 < r1² + r2².
Proof. ra. Qed.

(** r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 <-> r1² + r2² + r3² <> 0 *)
Lemma Rplus_sqr_neq0_iff3 : forall r1 r2 r3 : R,
  r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 <-> r1² + r2² + r3² <> 0.
Proof. ra. Qed.

(** r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 \/ r4 <> 0 <->
    r1² + r2² + r3² + r4² <> 0 *)
Lemma Rplus_sqr_neq0_iff4 : forall r1 r2 r3 r4 : R,
  r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 \/ r4 <> 0 <-> r1² + r2² + r3² + r4² <> 0.
Proof. ra. Qed.

Global Hint Resolve
  Rle_0_xx             (* 0 <= x * x *)
  Rplus_sqr_ge0        (* 0 <= r1² + r2² *)
  Rplus_sqr_ge0_form2  (* 0 <= r1² + r2² *)
  Rplus_sqr_gt0        (* 0 < r1² + r2² *)
  Rplus_sqr_eq_0_l     (* r1² + r2² = 0 -> r1 = 0 *)
  Rplus_sqr_eq_0_r     (* r1² + r2² = 0 -> r2 = 0 *)
  Rplus_sqr_neq0_iff2  (* r1<>0 \/ r2<>0 <-> r1² + r2²<>0 *)
  Rplus_sqr_neq0_iff3  (* r1,r2,r3, ... *)
  Rplus_sqr_neq0_iff4  (* r1,r2,r3,r4, ... *)
  Rplus_sqr_sqr_neq0_iff_Rplus_sqr_sqr_gt0 (* r1² + r2²<>0 <-> 0 <r1² + r2² *)
  R_neq1               (* 2 * a * b <= a² + b² *)
  : R.

Section test.
  (** r * r = 0 <-> r = 0 *)
  Goal forall r, r * r = 0 <-> r = 0. ra. Qed.
  Goal forall r, r * r <> 0 <-> r <> 0. ra. Qed.
  Goal forall r1 r2 : R, 0 <= r1 * r1 + r2 * r2. ra. Qed.
  Goal forall r1 r2 : R,  r1 <> 0 \/ r2 <> 0 <-> r1 * r1 + r2 * r2 <> 0. ra. Qed.
  Goal forall r1 r2 : R,  r1 * r1 + r2 * r2 <> 0 <-> 0 < r1 * r1 + r2 * r2. ra. Qed.
  Goal forall r1 r2 r3 : R,
      r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 <-> r1 * r1 + r2 * r2 + r3 * r3 <> 0. ra. Qed.
  Goal forall r1 r2 r3 r4 : R,
      r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 \/ r4 <> 0 <->
        r1 * r1 + r2 * r2 + r3 * r3 + r4 * r4 <> 0. ra. Qed.
End test.

(* ======================================================================= *)
(** ** About "absolute value" *)

Lemma Rabs_neg_left : forall r, 0 <= r -> Rabs (-r) = r.
Proof.
  intros. rewrite Rabs_Ropp. apply Rabs_right; nra.
Qed.

Lemma Rabs_neg_right : forall r, r < 0 -> Rabs (-r) = -r.
Proof.
  intros. rewrite Rabs_Ropp. apply Rabs_left; nra.
Qed.

Global Hint Resolve
  Rabs_right     (* r >= 0 -> Rabs r = r *)
  Rabs_pos_eq    (* 0 <= r -> Rabs r = r *)
  Rabs_left      (* r < 0 -> Rabs r = - r *)
  Rabs_left1     (* r <= 0 -> Rabs r = - r *)
  Rabs_neg_left  (* 0 <= r -> Rabs (-r) = r *)
  Rabs_neg_right (* r < 0 -> Rabs (-r) = -r *)
  : R.

(* ======================================================================= *)
(** ** About "sqrt" *)

Lemma sqrt_square_abs : forall r, sqrt (r * r) = Rabs r.
Proof.
  intros. destruct (Rcase_abs r).
  - replace (r * r) with ((-r) * (-r)) by nra.
    rewrite sqrt_square; try nra. auto with R.
  - rewrite sqrt_square; auto with R.
Qed.

Lemma sqrt_1 : sqrt 1 = 1.
Proof.
  apply Rsqr_inj; autorewrite with R; auto with R.
Qed.

Lemma sqrt_le0_eq_0 : forall r, r <= 0 -> sqrt r = 0.
Proof.
  intros. Transparent sqrt. unfold sqrt. destruct (Rcase_abs r); auto.
  assert (r = 0); try lra. subst. compute.
  destruct (Rsqrt_exists). destruct a.
  symmetry in H1. auto with R.
Qed.

Lemma sqrt_lt0_eq_0 : forall r, r < 0 -> sqrt r = 0.
Proof.
  intros. apply sqrt_le0_eq_0. auto with R.
Qed.

Lemma le0_imply_sqrt_eq0 : forall (x : R), x < 0 -> sqrt x = 0.
Proof.
  intros. unfold sqrt. destruct (Rcase_abs x); auto.
  (* although, x < 0, x >= 0, all appear, lra fail to solve it. *)
  exfalso. lra.
Qed.

Lemma sqrt_gt0_imply_gt0 : forall (x : R), 0 < sqrt x -> 0 < x.
Proof.
  intros. replace 0 with (sqrt 0) in H; auto with R.
  apply sqrt_lt_0_alt in H; auto.
Qed.

Lemma sqrt_gt0_imply_ge0 : forall (x : R), 0 < sqrt x -> 0 <= x.
Proof.
  intros. apply Rlt_le. apply sqrt_gt0_imply_gt0; auto.
Qed.

Lemma sqrt_eq1_imply_eq1 : forall (x : R), sqrt x = 1 -> x = 1.
Proof.
  intros.
  assert ((sqrt x)² = 1). rewrite H. autounfold with R in *; ring.
  rewrite <- H0.
  apply eq_sym. apply Rsqr_sqrt.
  assert (0 < sqrt x). rewrite H; auto with R.
  apply sqrt_gt0_imply_gt0 in H1. auto with R.
Qed.

Lemma sqrt_eq1_imply_eq1_rev : forall (x : R), x = 1 -> sqrt x = 1.
Proof.
  intros. rewrite H. rewrite sqrt_1. auto.
Qed.

(** ( √ r1 * √ r2)^2 = r1 * r2 *)
Lemma Rsqr_sqrt_sqrt r1 r2 : 0 <= r1 -> 0 <= r2 ->
  ((sqrt r1) * (sqrt r2))² = r1 * r2.
Proof.
  destruct (Rcase_abs r1), (Rcase_abs r2); try lra.
  autorewrite with R; auto with R.
  rewrite ?Rsqr_sqrt; auto with R.
Qed.

(** If the sqrt of the sum of squares of two real numbers equal to 0, iff both of
    them are 0. *)
Lemma Rsqrt_plus_sqr_eq0_iff : forall r1 r2 : R,
  sqrt (r1² + r2²) = 0 <-> r1 = 0 /\ r2 = 0.
Proof.
  intros. autorewrite with R. split; intros H.
  - apply sqrt_eq_0 in H.
    + split; eauto with R.
    + apply Rplus_sqr_ge0.
  - destruct H; subst. autorewrite with R; auto with R.
Qed.

(** The multiplication of the square roots of two real numbers is >= 0 *)
Lemma Rmult_sqrt_sqrt_ge0 : forall r1 r2 : R, 0 <= (sqrt r1) * (sqrt r2).
Proof.
  intros. apply Rmult_le_pos; auto with R.
Qed.

(** The addition of the square roots of two real numbers is >= 0 *)
Lemma Rplus_sqrt_sqrt_ge0 : forall r1 r2 : R, 0 <= (sqrt r1) + (sqrt r2).
Proof.
  intros. apply Rplus_le_le_0_compat; auto with R.
Qed.

Lemma Rsqr_plus_sqr_neq0_l : forall r1 r2, r1 <> 0 -> sqrt (r1² + r2²) <> 0.
Proof.
  intros. auto 6 with R.
Qed.

Lemma Rsqr_plus_sqr_neq0_r : forall r1 r2, r2 <> 0 -> sqrt (r1² + r2²) <> 0.
Proof.
  intros. auto 6 with R.
Qed.

(** /(sqrt (1+(b/a)²)) = abs(a) / sqrt(a*a + b*b) *)
Lemma Rinv_sqrt_plus_1_sqr_div_a_b (a b : R) : a <> 0 ->
  (/ (sqrt (1+(b/a)²)) = (Rabs a) / sqrt(a*a + b*b)).
Proof.
  intros.
  replace (1 + (b/a)²) with ((a*a + b*b) / ((Rabs a)*(Rabs a))).
  - rewrite sqrt_div_alt.
    + rewrite sqrt_square.
      * field. split; autorewrite with R; auto 6 with R.
      * auto with R.
    + autorewrite with R; auto with R.
  - unfold Rsqr.
    destruct (Rcase_abs a).
    + replace (Rabs a) with (-a). field; auto. rewrite Rabs_left; auto.
    + replace (Rabs a) with a. field; auto. rewrite Rabs_right; auto.
Qed.

(** (√ r1 * √ r2) * (√ r1 * √ r2) = r1 * r2 *)
Lemma sqrt_mult_sqrt : forall (r1 r2 : R),
  0 <= r1 -> 0 <= r2 ->
  ((sqrt r1) * (sqrt r2)) * ((sqrt r1) * (sqrt r2)) = r1 * r2.
Proof.
  intros. ring_simplify. repeat rewrite pow2_sqrt; auto.
Qed.

#[export] Hint Rewrite
  sqrt_square_abs         (* sqrt (r * r) = Rabs r *)
  (* Rsqr_sqrt               (* 0 <= x -> (sqrt x)² = x *) *)
  sqrt_1                  (* sqrt 1 = 1 *)
  Rsqr_sqrt_sqrt          (* ( √ r1 * √ r2)² = r1 * r2 *)
  sqrt_mult_sqrt          (* (√ r1 * √ r2) * (√ r1 * √ r2) = r1 * r2 *)
  : R.

Global Hint Resolve
  sqrt_1                  (* sqrt 1 = 1 *)
  sqrt_le0_eq_0           (* r <= 0 -> sqrt r = 0 *)
  sqrt_lt0_eq_0           (* r < 0 -> sqrt r = 0 *)
  le0_imply_sqrt_eq0      (* x < 0 -> sqrt x = 0 *)
  sqrt_gt0_imply_gt0      (* 0 < sqrt x -> 0 < x *)
  sqrt_gt0_imply_ge0      (* 0 < sqrt x -> 0 <= x *)
  sqrt_eq1_imply_eq1      (* sqrt x = 1 -> x = 1 *)
  Rsqr_sqrt_sqrt          (* ( √ r1 * √ r2)² = r1 * r2 *)
  sqrt_mult_sqrt          (* (√ r1 * √ r2) * (√ r1 * √ r2) = r1 * r2 *)
  Rmult_sqrt_sqrt_ge0     (* 0 <= (sqrt r1) * (sqrt r2) *)
  Rplus_sqrt_sqrt_ge0     (* 0 <= (sqrt r1) + (sqrt r2) *)
  sqrt_square             (* 0 <= x -> sqrt (x * x) = x *)
  Rsqr_plus_sqr_neq0_l    (* r1 <> 0 -> sqrt (r1² + r2²) <> 0 *)
  Rsqr_plus_sqr_neq0_r    (* r2 <> 0 -> sqrt (r1² + r2²) <> 0 *)
  : R.

(** simplify expression has sqrt and pow2 *)
Ltac simpl_sqrt_pow2 :=
  repeat (
  (* (_²) -> x * x *)
  unfold Rsqr;
  (* (sqrt r1 * sqrt r2)^2 = r1 * r2 *)
  try rewrite sqrt_mult_sqrt;
  (* (sqrt x) ^ 2 = x *)
  try rewrite pow2_sqrt;
  (* sqrt (x ^ 2) = x *)
  try rewrite sqrt_pow2;
  (* (sqrt x * sqrt x) = x *)
  try rewrite sqrt_sqrt
  ).

Section TEST_Rsqrt.
  Goal sqrt R1 = R1. autorewrite with R; auto with R. Qed.

End TEST_Rsqrt.

(** Automatically prove the goal such as "sqrt x = y" *)
Ltac solve_sqrt_eq :=
  match goal with
  | |- sqrt ?x = ?y => apply Rsqr_inj; [ra|ra|rewrite Rsqr_sqrt;ra]
  end.

(* ======================================================================= *)
(** ** About "trigonometric functions" *)

(*  sin (- (PI/2)) = -1 *)
Lemma sin_PI2_neg : sin (- (PI/2)) = -1.
Proof.
  rewrite sin_neg. rewrite sin_PI2. auto.
Qed.

(* cos (- (PI/2)) = 0 *)
Lemma cos_PI2_neg : cos (- (PI/2)) = 0.
Proof.
  rewrite cos_neg. apply cos_PI2.
Qed.

(* sin (r + PI) = - (sin r) *)
Lemma sin_plus_PI : forall r, sin (r + PI) = (- (sin r))%R.
Proof.
  apply neg_sin.
Qed.

(* sin (r - PI) = - (sin r) *)
Lemma sin_sub_PI : forall r, sin (r - PI) = (- (sin r))%R.
Proof.
  intros. replace (r - PI)%R with (- (PI - r))%R; try ring.
  rewrite sin_neg. rewrite Rtrigo_facts.sin_pi_minus. auto.
Qed.

(* cos (r + PI) = - (cos r) *)
Lemma cos_plus_PI : forall r, cos (r + PI) = (- (cos r))%R.
Proof.
  apply neg_cos.
Qed.

(* cos (r - PI) = - (cos r) *)
Lemma cos_sub_PI : forall r, cos (r - PI) = (- (cos r))%R.
Proof.
  intros. replace (r - PI)%R with (- (PI - r))%R; try ring.
  rewrite cos_neg. apply Rtrigo_facts.cos_pi_minus.
Qed.

Lemma cos2_sin2: forall x : R, (cos x)² + (sin x)² = 1.
Proof.
  intros. rewrite Rplus_comm. apply sin2_cos2.
Qed.

#[export] Hint Rewrite
  sin_0         (* sin 0 = 0 *)
  cos_0         (* cos 0 = 1 *)
  sin_PI2       (* sin (PI / 2) = 1 *)
  cos_PI2       (* cos (PI / 2) = 0 *)
  sin_PI2_neg   (* sin (- (PI/2)) = -1 *)
  cos_PI2_neg   (* cos (- (PI/2)) = 0 *)
  sin_plus_PI   (* sin (r + PI) = - (sin r) *)
  sin_sub_PI    (* sin (r - PI) = - (sin r) *)
  cos_plus_PI   (* cos (r + PI) = - (cos r) *)
  cos_sub_PI    (* cos (r - PI) = - (cos r) *)
  sin2_cos2     (* (sin x)² + (cos x)² = 1 *)
  cos2_sin2     (* (cos x)² + (sin x)² = 1 *)
  : R.

#[export] Hint Resolve
  sin_0         (* sin 0 = 0 *)
  cos_0         (* cos 0 = 1 *)
  sin_PI2       (* sin (PI / 2) = 1 *)
  cos_PI2       (* cos (PI / 2) = 0 *)
  sin_PI2_neg   (* sin (- (PI/2)) = -1 *)
  cos_PI2_neg   (* cos (- (PI/2)) = 0 *)
  sin_plus_PI   (* sin (r + PI) = - (sin r) *)
  sin_sub_PI    (* sin (r - PI) = - (sin r) *)
  cos_plus_PI   (* cos (r + PI) = - (cos r) *)
  cos_sub_PI    (* cos (r - PI) = - (cos r) *)
  sin2_cos2     (* (sin x)² + (cos x)² = 1 *)
  cos2_sin2     (* (cos x)² + (sin x)² = 1 *)
  : R.

Section TEST_sin_cos_tan.
  Goal forall x, cos x * cos x + sin x * sin x = R1.
  intros; autorewrite with R; auto with R. Qed.

  Goal forall x, sin x * sin x + cos x * cos x = R1.
  intros; autorewrite with R; auto with R. Qed.

End TEST_sin_cos_tan.

(* ======================================================================= *)
(** ** About "Rpower" *)

(**
Rpower rules:
<<
  1. Definition of Rpower
  a^n       = a * a * ... * a    (* there are n numbers *)
  a^0       = 1 (a ≠ 0)
  a^(-n)    = 1 / a^n (a ≠ 0)
  a^(m/n)   = n√ a^m  (a > 0)
  a^(-m/n)  = 1 / n√ a^m  (a > 0)
>>
 *)
Lemma Rpower_neq0 x y : x <> 0 -> Rpower x y <> 0.
Proof.
  zify.

  Abort.

(* ######################################################################### *)
(** * Automatic solving equalites or inequalities on real numbers *)

(* ======================================================================= *)
(** ** r = 0 *)

Lemma Rmult_eq_self_imply_0_or_k1 : forall k x,
    k * x = x -> x = 0 \/ (x <> 0 /\ k = R1).
Proof. ra. Qed.

Section TEST_r_eq_0.
  Goal forall r r1 r2 : R, r * r1 = r * r2 -> r1 <> r2 -> r = 0. ra. Qed.
  Goal forall r r1 r2 : R, r1 * r = r2 * r -> r1 <> r2 -> r = 0. ra. Qed.
  Goal forall r, r = 0 -> r² = 0. ra. Qed.
End TEST_r_eq_0.

(* ======================================================================= *)
(** ** 0 <= x *)

(** deprecated *)
(* Ltac zero_le := *)
(*   intros; autorewrite with R; *)
(*   repeat (match goal with *)
(*   | |- 0 <= ?r1 * ?r2 => apply Rmult_le_pos *)
(*   | |- _ => idtac *)
(*   end; *)
(*   auto with R; try lra). *)

Section TEST_zero_le.
  Goal forall r, 0 <= r * r. ra. Qed.
  Goal forall r, 0 <= r². ra. Qed.
  Goal forall r1 r2, 0 <= r1 * r1 + r2 * r2. ra. Qed.
  Goal forall r1 r2, 0 <= r1² + r2². ra. Qed.
  Goal forall r1 r2, 0 <= r1 * r1 + r2². ra. Qed.
  Goal forall r1 r2, 0 <= r1² + r2 * r2. ra. Qed.
  Goal forall r, 0 <= r -> 0 <= r * 5. ra. Qed.
  Goal forall r, 0 <= r -> 0 <= r * 5 * 10. ra. Qed.
  Goal forall r, 0 <= r -> 0 <= r * (/5) * 10. ra. Qed.
End TEST_zero_le.

(* ======================================================================= *)
(** ** 0 < x *)

(** deprecated *)
(* Ltac zero_lt := *)
(*   intros; autorewrite with R; *)
(*   match goal with *)
(*   | H : ?r1 <> 0 |- 0 < ?r1² + ?r2² => apply Rneq0_imply_Rplus_gt0_2_1 *)
(*   | H : ?r2 <> 0 |- 0 < ?r1² + ?r2² => apply Rneq0_imply_Rplus_gt0_2_2 *)
(*   | H : 0 < ?r1  |- 0 < ?r1² + ?r2² => apply Rgt0_imply_Rplus_gt0_2_1 *)
(*   | H : 0 < ?r2  |- 0 < ?r1² + ?r2² => apply Rgt0_imply_Rplus_gt0_2_2 *)
(*   | H : 0 < ?r1  |- 0 < ?r1 * ?r2 => apply Rmult_lt_0_compat *)
(*   (* these methods are too ugly, but could work now *) *)
(*   | |- (0 < ?r1 + ?r2)%R => apply Rplus_lt_0_compat *)
(*   | |- (0 < ?r1 * ?r2)%R => apply Rmult_lt_0_compat *)
(*   | |- (0 < ?r1²)%R => apply Rlt_0_sqr *)
(*   | |- _ => idtac *)
(*   end; *)
(*   auto with R; try lra. *)

Section TEST_zero_lt.
  Goal forall r, 0 <> r -> 0 < r * r. ra. Qed.
  Goal forall r, 0 <> r -> 0 < r². ra. Qed.
  Goal forall r, 0 < r -> 0 < r * r. ra. Qed.
  Goal forall r, 0 < r -> 0 < r². ra. Qed.
  Goal forall r1 r2, r1 <> 0 -> 0 < r1 * r1 + r2 * r2. ra. Qed.
  Goal forall r1 r2, r1 <> 0 -> 0 < r1² + r2 * r2. ra. Qed.
  Goal forall r1 r2, r1 <> 0 -> 0 < r1 * r1 + r2². ra. Qed.

  Goal forall r1 r2, r2 <> 0 -> 0 < r1 * r1 + r2 * r2. ra. Qed.
  Goal forall r1 r2, r2 <> 0 -> 0 < r1² + r2 * r2. ra. Qed.
  Goal forall r1 r2, r2 <> 0 -> 0 < r1 * r1 + r2². ra. Qed.

  Goal forall r1 r2, 0 < r1 -> 0 < r1 * r1 + r2 * r2. ra. Qed.
  Goal forall r1 r2, 0 < r2 -> 0 < r1 * r1 + r2 * r2. ra. Qed.

  Goal forall r, 0 < r -> 0 < r * 10. ra. Qed.
  Goal forall r, 0 < r -> 0 < r + 10. ra. Qed.
  Goal forall r, 0 < r -> 0 < r * 100 + 23732. ra. Qed.

End TEST_zero_lt.

(** This property is used in in Complex. Although lra can solve it, but using a
    special lemma name combined with the match machanism could speed up the proof. *)
Lemma Rneq_le_lt : forall a b, a <> b -> a <= b -> a < b.
Proof. ra. Qed.

(* ======================================================================= *)
(** ** x <> 0 *)

(* (** deprecated *) *)
(* Ltac neq_zero := *)
(*   intros; autorewrite with R in *; *)
(*   repeat match goal with *)
(*   (* symmetry *) *)
(*   | H : 0 <> ?a |- ?b <> 0 => apply not_eq_sym in H *)
(*   | H : 0 <> ?a |- 0 <> ?b => apply not_eq_sym in H; apply not_eq_sym *)
(*   (* normal *) *)
(*   | _ : 0 < ?r |- ?r <> 0 => apply zero_lt_imply_Rneq0 *)
(*   | _ : ?r1 <> 0 |- ?r1² <> 0 => apply Rneq0_imply_Rsqr_neq0 *)
(*   | _ : ?r1² <> 0 |- ?r1 <> 0 => apply Rsqr_neq0_imply_Rneq0 *)
(*   | _ : ?r1 + ?r2 <> 0, _ : ?r1 = 0 |- ?r2 <> 0 =>  *)
(*     apply Rplus_neq0_imply_Rneq0_2_1 *)
(*   | _ : ?r1 + ?r2 <> 0, _ : ?r2 = 0 |- ?r1 <> 0 =>  *)
(*     apply Rplus_neq0_imply_Rneq0_2_2 *)
(*   (* default *) *)
(* (*   | |- ?b <> 0 => apply zero_lt_imply_Rneq0 *) *)
(*   | |- _ => idtac *)
(*   end; *)
(*   auto with R. *)

Section TEST_neq_zero.
  Goal forall r, r² <> 0 <-> r <> 0. ra. Qed.
  Goal forall r, r² <> 0 -> r <> 0. ra. Qed.
  Goal forall r, r <> 0 -> r * r <> 0. ra. Qed.
  Goal forall r, r <> 0 -> r² <> 0. ra. Qed.

  Goal forall r, 0 <> r * r -> r <> 0. ra. Qed.
  Goal forall r, r * r <> 0 -> 0 <> r. ra. Qed.
  Goal forall r, 0 <> r * r -> 0 <> r. ra. Qed.

  Goal forall r1 r2 r3 r4 : R,
    r1 <> 0 \/ r2 <> 0 \/ r3 <> 0 \/ r4 <> 0 <->
    r1 * r1 + r2 * r2 + r3 * r3 + r4 * r4 <> 0.
  Proof. ra. Qed.

End TEST_neq_zero.

(* ======================================================================= *)
(** ** a < b *)

Lemma Rdiv_le_imply_Rmul_gt a b c : b > 0 -> a * /b < c -> a < b * c.
Proof.
  intros.
  apply (Rmult_lt_compat_l b) in H0; auto.
  replace (b * (a * /b)) with a in H0; auto.
  field. auto with R.
Qed.
Global Hint Resolve Rdiv_le_imply_Rmul_gt : R.

Lemma Rmul_gt_imply_Rdiv_le a b c : b > 0 -> a < b * c -> a * /b < c.
Proof.
  intros.
  apply (Rmult_lt_compat_l (/b)) in H0; auto with R.
  autorewrite with R in *.
  replace (/b * a) with (a / b) in *; try field; auto with R.
  replace (/b * (b * c)) with c in *; try field; auto with R.
Qed.
Global Hint Resolve Rmul_gt_imply_Rdiv_le : R.

(* Global Hint Resolve  *)
(*     Rminus_gt_0_lt  (* 0 < b - a -> a < b *) *)
(*     Rlt_Rminus      (* a < b -> 0 < b - a *) *)
(*     Rlt_minus       (* r1 < r2 -> r1 - r2 < 0 *) *)
(*     : R. *)

Ltac tac_le :=
  autounfold with R;
  match goal with
  | |- 0 < ?a + - ?b => apply Rlt_Rminus
  | |- ?a * (?b * /?c) < ?e => replace (a * (b * /c)) with ((a * b) * /c)
  | |- ?a * /?b < ?c => assert (a < b * c); assert (0 < b)
  | |- _ => idtac
  end; try lra; auto with R.

Section TEST_tac_le.

  (** This proof cannot be finished in one step *)
  Goal forall h T, 0 < h -> h < 9200 -> -60 < T -> T < 60 -> h / (273.15 + T) < 153.
    ra. Abort.

  (** Naming the hypothesises *)
  Variable h T : R.
  Hypothesis Hh1 : 0 < h.
  Hypothesis Hh2 : h < 9200.
  Hypothesis HT1 : -60 < T.
  Hypothesis HT2 : T < 60.

  (** a simpler proposition can be proved in one step *)
  Goal h * 0.0065 < 273.15 + T. ra. Qed.

  (** We can finish the original proof with manually help *)
  Goal h / (273.15 + T) < 153.
    autounfold with R.
    assert (273.15 + T > 0). ra.
    assert (h < (273.15 + T) * 153). ra. auto with R.
  Qed.

  (** Another example, also need to manually *)
  Goal h / (273.15 + T) < 1 / 0.0065.
  Proof.
    ra. (* can not finish it *)
    autounfold with R.
    assert (273.15 + T > 0). ra.
    assert (h < (273.15 + T) * (1/0.0065)). ra. auto with R.
  Qed.

  (* This example shows the usage of tac_le tactic *)
  Goal h / (273.15 + T) < 1 / 0.0065.
  Proof.
    tac_le.
  Qed.

  (** This example shows the usage of tac_le and ra together. *)
  Goal  0 < 1 - (0.0065 * (h * / (273.15 + T))).
  Proof.
    (* construct condition manually, then try to automate *)
    assert (h / (273.15 + T) < 1/0.0065).
    tac_le. ra.
  Qed.

  Goal 0 < 1 - (0.0065 * (h * / (273.15 + T))).
  Proof.
    do 3 tac_le.
  Qed.

End TEST_tac_le.

(* ======================================================================= *)
(** ** Compare with PI *)
Section compare_with_PI.

  (** How to prove the inequalities about PI *)
  Goal 2 < PI.
  Proof.
  Abort.

  (** One method: give the upper and lower bound of PI with concrete value by axiom,
      then use transitivity to solve it by lra. *)
  Definition PI_ub : R := 3.14159266.
  Definition PI_lb : R := 3.14159265.
  Axiom PI_lt : PI < PI_ub.
  Axiom PI_gt : PI_lb < PI.

  Goal 2 < PI.
  Proof.
    apply Rlt_trans with PI_lb; unfold PI_lb. lra. apply PI_gt.
  Qed.

End compare_with_PI.

(* ======================================================================= *)
(** ** These are old code early, need to be discarded gradually *)

(* (** a + b <> 0 *) *)
(* Ltac plus_neq0 := *)
(*   match goal with *)
(*   | |- ?a + ?b <> 0 => apply Rgt_not_eq,Rlt_gt,Rplus_lt_0_compat;  *)
(*     auto with R fcs *)
(*   end. *)

(* (** 0 < a *) *)
(* Ltac zero_lt := *)
(*   repeat match goal with *)
(*   (* 0 *) *)
(*   | H: ?a <> 0 |- 0 < ?a * ?a => apply Rlt_0_sqr; apply H *)
(*   | |- 0 < ?a + ?b => apply Rplus_lt_0_compat *)
(*   | |- 0 < ?a * ?b => apply Rmult_lt_0_compat *)
(*   | |- 0 < sqrt ?a => apply sqrt_lt_R0 *)
(*   | |- 0 < ?a / ?b => unfold Rdiv *)
(*   | |- 0 < / ?a => apply Rinv_0_lt_compat *)
(*   | |- 0 < ?a ^ _ => simpl *)
(*   | |- 0 < (?a)² => unfold Rsqr *)
(*   | |- 0 < ?a => auto with R fcs; try lra *)
(*   (* R0 *) *)
(*   | |- R0 < ?a * ?b => apply Rmult_lt_0_compat; try lra; auto with R fcs *)
(*   | |- R0 < sqrt ?a => apply sqrt_lt_R0 *)
(*   | |- R0 < ?a / ?b => unfold Rdiv *)
(*   | |- R0 < / ?a => apply Rinv_0_lt_compat *)
(*   | |- R0 < ?a ^ _ => simpl *)
(*   | |- R0 < (?a)² => unfold Rsqr *)
(*   | |- R0 < ?a => auto with R fcs; try lra *)
(*   end. *)

(* (** 0 <= a *) *)
(* Ltac zero_le := *)
(*   (* simplify sqrt+pow2 *) *)
(*   repeat ( *)
(*   try simpl_sqrt_pow2; *)
(*   try match goal with *)
(*   (* 0 <= sqrt x *) *)
(*   | |- 0 <= sqrt _ => apply sqrt_pos *)
(*   (* 0 <= a * a *) *)
(*   | |- 0 <= ?a * ?a => apply Rle_0_sqr *)
(*   (* 0 <= a -> 0 <= b -> 0 <= a + b *)  *)
(*   | |- 0 <= ?a + ?b => apply Rplus_le_le_0_compat *)
(*   (* 0 <= a -> 0 <= b -> 0 <= a * b *) *)
(*   | |- 0 <= ?a * ?b => apply Rmult_le_pos *)
(*   (* if fail, proof < again *) *)
(* (*   | |- 0 <= ?a => apply Rlt_le; zero_le *)
(*   | |- R0 <= ?a => apply Rlt_le; zero_le *) *)
(*   end). *)

(* (** a * b <> 0 *) *)
(* Ltac mult_neq0 := *)
(*   match goal with *)
(*   | |- ?a * ?b <> 0 => apply Rgt_not_eq,Rlt_gt;zero_le *)
(*   end. *)

(* (** a <> 0 *) *)
(* Ltac neq0 := *)
(*   repeat match goal with *)
(*   | |- ?a /\ ?b => repeat split *)
(*   | |- ?a <> 0 => apply Rgt_not_eq,Rlt_gt; zero_le *)
(*   end. *)

(** Simplification for trigonometric functions *)

(* Lemma xx_sqr : forall x:R, x * x = Rsqr x. *)
(* Proof. auto. Qed. *)

(* Lemma cos2_sin2' : forall x:R, Rsqr (cos x) + Rsqr (sin x) = 1. *)
(* Proof. intros. autorewrite with R. auto with R. Qed. *)

(* Lemma cos_sin : forall x:R, cos x * sin x = sin x * cos x. *)
(* Proof. ra. Qed. *)

(* Lemma x_neg_x : forall x:R, x + - x = 0. *)
(* Proof. ra. Qed. *)

(* Lemma neg_x_x : forall x:R, -x + x = 0. *)
(* Proof. intros. lra. Qed. *)

(* Lemma x_mul_neg_x : forall x y : R, y * -x = - (x * y). *)
(* Proof. intros. lra. Qed. *)

(* Lemma neg_x_mul_x : forall x y : R, -y * x = - (y * x). *)
(* Proof. intros. lra. Qed. *)

(* Lemma sqrR1_R1 : R1² = R1. *)
(* Proof. unfold Rsqr. ring. Qed. *)

(* Lemma one_R1 : 1 = R1. *)
(* Proof. ring. Qed. *)

(* Lemma inv1_R1 : /1 = R1. *)
(* Proof. field. Qed. *)

(* Lemma invR1_R1 : /R1 = R1. *)
(* Proof. field. Qed. *)

(* Lemma sqrtR1_R1 : sqrt R1 = R1. *)
(* Proof. apply Rsqr_inj. zero_le. lra. rewrite Rsqr_sqrt. *)
(*   rewrite sqrR1_R1. auto. lra. *)
(* Qed. *)

(* Lemma sqrt1_R1 : sqrt 1 = R1. *)
(* Proof. rewrite one_R1. apply sqrtR1_R1. Qed. *)

(* Lemma coscos_sinsin : forall x : R, (cos x * cos x + sin x * sin x) = 1. *)
(* Proof. intros. rewrite ?xx_sqr. rewrite ?cos2_sin2. auto. Qed. *)

(* Lemma sinsin_coscos : forall x : R, (sin x * sin x + cos x * cos x) = 1. *)
(* Proof. intros. rewrite ?xx_sqr. rewrite ?sin2_cos2. auto. Qed. *)

(* (** r1 - (-r2) = r1 + r2 *) *)
(* Lemma Rsub_Rneg : forall (r1 r2 : R), r1 - (- r2) = r1 + r2. *)
(* Proof. intros. ring. Qed. *)

(* (** Simplify trigonometric function and expression of real number *) *)
(* Ltac trigo_simp :=  *)
(*   rewrite ?Rmult_opp_opp;   (* -x * -x = x * x *) *)
(* (*   rewrite ?xx_sqr;          (* x * x = Rsqr x  *) *) *)
(*   rewrite ?Rsub_Rneg,       (* r1 - (-r2) = r1 + r2 *) *)
(*           ?sin2_cos2,       (* sin^2 + cos^2 = 1 *) *)
(*           ?cos2_sin2,       (* cos^2 + sin^2 = 1 *) *)
(*           ?coscos_sinsin,   (* cos*cos + sin*sin = 1 *) *)
(*           ?sinsin_coscos,   (* sin*sin + cos*cos = 1 *) *)
(*           ?cos_sin,         (* cos * sin = sin * cos *) *)
(*           ?x_mul_neg_x,     (* y * -x = - (x * y) *) *)
(*           ?neg_x_mul_x,     (* -y * x = - (x * y) *) *)
(*           ?x_neg_x,         (* x + -x = 0 *) *)
(*           ?neg_x_x,         (* -x + x = 0 *) *)
(*           ?sqrtR1_R1,       (* sqrt R1 = R1 *) *)
(*           ?sqrt1_R1,        (* sqrt 1 = 1 *) *)
(*           ?sqrR1_R1,        (* R1² = R1 *) *)
(* (*           ?Rinv_1,           (* /1 = 1 *) *) *)
(*           ?inv1_R1,         (* /1 = R1 *) *)
(*           ?invR1_R1,        (* /R1 = R1 *) *)
(*           ?one_R1           (* 1 = R1 *) *)
(*   ; *)
(*   autorewrite with R;       (* +0, 0+, *0, 0*, *1, 1* *) *)
(*   try field; *)
(*   auto. *)

(* (* sqrt x = R1 -> x = R1 *) *)
(* Lemma sqrt_eqR1_imply_R1 : forall (x : R), sqrt x = R1 -> x = R1. *)
(* Proof. *)
(*   intros. *)
(*   assert ((sqrt x)² = R1). rewrite H. unfold Rsqr. lra. rewrite <- H0. *)
(*   rewrite Rsqr_sqrt; auto. *)
(*   assert (0 < sqrt x). rewrite H. lra.  *)
(*   apply sqrt_gt0_imply_gt0 in H1. lra. *)
(* Qed. *)

(* ######################################################################### *)
(** * Conversion between R and other types *)

(** Remark:

    We need two functions commonly used in computer: floor (rounding down), and
    ceiling (rounding up). Although the function "up" in Coq-std-lib is looks like
    a rounding up function, but it is a bit different. We need to explicitly
    define them. Meanwhile, we tested their behaviors on negative numbers

    The behavior of "up" is this:
        r∈[2.0,3.0) -> up(r)=3,
    and there is a lemma saying this:
        Check archimed. (* IZR (up r) > r /\ IZR (up r) - r <= 1 *)

    But we need the behavior of floor and ceiling are these below exactly:
    1. floor
       r∈[2.0,3.0), floor(r)=2
       So, floor(r) = up(r) - 1
    2. ceiling
       r∈(2.0,3.0), ceiling(r)=3
       r=2.0, ceiling(r)=2
       So, if IZR(up(r))=r，then ceiling(r)=up(r)-1，else ceiling(r)=up(r).

    When talking about negative numbers, their behaviors are below:
    floor    2.0 = 2
    floor    2.5 = 2
    floor   -2.0 = -2
    floor   -2.5 = -3

    ceiling  2.0 = 2
    ceiling  2.5 = 3
    ceiling -2.0 = -2
    ceiling -2.5 = -2
 *)

(** ** Properties about up and IZR *)

(** Eliminate the up_IZR *)
Lemma up_IZR : forall z, up (IZR z) = (z + 1)%Z.
Proof.
  intros.
  rewrite up_tech with (r:=IZR z); auto; ra.
  apply IZR_lt. lia.
Qed.

(** There is a unique integer if such a IZR_up equation holds. *)
Lemma IZR_up_unique : forall r, r = IZR (up r - 1) -> exists! z, IZR z = r.
Proof.
  intros.
  exists (up r - 1)%Z. split; auto.
  intros. subst.
  rewrite up_IZR in *.
  apply eq_IZR. auto.
Qed.

(** There isn't any integer z and real number r such that r ∈(IZR z, IZR (z+1)) *)
Lemma IZR_in_range_imply_no_integer : forall r z,
    IZR z < r ->
    r < IZR (z + 1) ->
    ~(exists z', IZR z' = r).
Proof.
  intros. intro. destruct H1. subst.
  apply lt_IZR in H0.
  apply lt_IZR in H. lia.
Qed.

(* ######################################################################### *)
(** ** Conversion between R and other types *)

(** *** Conversion between Z and R *)

(** Z to R *)
Definition Z2R (z : Z) : R := IZR z.

(** Rounding R to z, take the floor: truncate to the nearest integer
    not greater than it *)
Definition R2Z_floor (r : R) : Z := (up r) - 1.

(** Rounding R to z, take the ceiling: truncate to the nearest integer
    not less than it *)
Definition R2Z_ceiling (r : R) : Z :=
  let z := up r in
  if Req_EM_T r (IZR (z - 1)%Z)
  then z - 1
  else z.

(* Compute R2Z_floor 0.5 *)

(** r∈[z,z+1.0) -> floor(r) = z *)
Lemma R2Z_floor_spec : forall r z,
    IZR z <= r < IZR z + 1.0 -> R2Z_floor r = z.
Proof.
  intros. unfold R2Z_floor in *. destruct H.
  assert (up r = z + 1)%Z; try lia.
  rewrite <- up_tech with (z:=z); auto.
  rewrite plus_IZR. lra.
Qed.

(** (r=z -> ceiling r = z) /\ (r∈(z,z+1.0) -> ceiling r = z+1) *)
Lemma R2Z_ceiling_spec : forall r z,
    (r = IZR z -> R2Z_ceiling r = z) /\
      (IZR z < r < IZR z + 1.0 -> R2Z_ceiling r = (z+1)%Z).
Proof.
  intros. unfold R2Z_ceiling in *. split; intros.
  - destruct (Req_EM_T r (IZR (up r - 1))).
    + rewrite H. rewrite up_IZR. lia.
    + rewrite H in n. destruct n.
      rewrite up_IZR. f_equal. lia.
  - destruct H. destruct (Req_EM_T r (IZR (up r - 1))).
    + apply IZR_in_range_imply_no_integer in H; auto.
      * destruct H. exists (up r - 1)%Z; auto.
      * rewrite plus_IZR. ra.
    + rewrite up_tech with (r:=r); auto; ra.
      rewrite plus_IZR. ra.
Qed.

(** Z2R (R2Z_floor r) is less than r *)
Lemma Z2R_R2Z_floor_le : forall r, Z2R (R2Z_floor r) <= r.
Proof.
  intros. unfold Z2R,R2Z_floor. rewrite minus_IZR.
  destruct (archimed r). ra.
Qed.

(** r-1 is less than Z2R (R2Z_floor r) *)
Lemma Z2R_R2Z_floor_gt : forall r, r - 1 < Z2R (R2Z_floor r).
Proof.
  intros. unfold Z2R,R2Z_floor. rewrite minus_IZR.
  destruct (archimed r). ra.
Qed.

(** *** Conversion between nat and R *)

Definition nat2R (n : nat) : R := Z2R (nat2Z n).
Definition R2nat_floor (r : R) : nat := Z2nat (R2Z_floor r).
Definition R2nat_ceiling (r : R) : nat := Z2nat (R2Z_ceiling r).

(* ######################################################################### *)
(** * Reqb,Rleb,Rltb: Boolean comparison of R *)

Definition Reqb (r1 r2 : R) : bool := HierarchySetoid.Aeqb r1 r2.
Definition Rleb (r1 r2 : R) : bool := if Rle_lt_dec r1 r2 then true else false.
Definition Rltb (r1 r2 : R) : bool := if Rlt_le_dec r1 r2 then true else false.
Infix "=?"  := Reqb : R_scope.
Infix "<=?" := Rleb : R_scope.
Infix "<?"  := Rltb : R_scope.
Infix ">?"  := (fun x y => y <? x) : R_scope.
Infix ">=?" := (fun x y => y <=? x) : R_scope.

(** Reflection of (=) and (=?) *)
(* Lemma Reqb_true : forall x y, x =? y = true <-> x = y. *)
(* Proof. *)
(*   apply Aeqb_true. *)
(* Qed. *)

(* Lemma Reqb_false : forall x y, x =? y = false <-> x <> y. *)
(* Proof. *)
(*   apply Aeqb_false. *)
(* Qed. *)
Lemma Reqb_reflect : forall x y, reflect (x = y) (x =? y).
Proof.
  intros. unfold Reqb,Aeqb. destruct (decidable); constructor; auto.
Qed.

Lemma Reqb_refl : forall r, r =? r = true.
Proof.
  intros. cbv. destruct Req_EM_T; auto.
Qed.

Lemma Reqb_comm : forall r1 r2, (r1 =? r2) = (r2 =? r1).
Proof.
  intros. cbv. destruct Req_EM_T,Req_EM_T; subst; auto. easy.
Qed.

Lemma Reqb_trans : forall r1 r2 r3, r1 =? r2 = true ->
  r2 =? r3 = true -> r1 =? r3 = true.
Proof.
  intros. cbv in *. destruct Req_EM_T,Req_EM_T,Req_EM_T; subst; auto.
Qed.

Lemma Rltb_reflect : forall x y, reflect (x < y) (x <? y).
Proof.
  intros. unfold Rltb. destruct (Rlt_le_dec x y); constructor; lra.
Qed.

Lemma Rleb_reflect : forall x y, reflect (x <= y) (x <=? y).
Proof.
  intros. unfold Rleb. destruct (Rle_lt_dec x y); constructor; lra.
Qed.

Lemma Rgtb_reflect : forall x y, reflect (x > y) (x >? y).
Proof.
  intros. unfold Rltb. destruct (Rlt_le_dec y x); constructor; lra.
Qed.

Lemma Rgeb_reflect : forall x y, reflect (x >= y) (x >=? y).
Proof.
  intros. unfold Rleb. destruct (Rle_lt_dec y x); constructor; lra.
Qed.

(* ######################################################################### *)
(** * Approximate of two real numbers *)

(** r1 ≈ r2, that means |r1 - r2| <= diff *)
Definition Rapprox (r1 r2 diff : R) : Prop := Rabs (r1 - r2) <= diff.

(** boolean version of approximate function *)
Definition Rapproxb (r1 r2 diff : R) : bool := Rleb (Rabs (r1 - r2)) diff.

(* ######################################################################### *)
(** * Mathematical Hierarchy *)

(* Global Instance EqReflect_R : EqReflect Reqb. *)
(* Proof. *)
(*   constructor. intros. *)
(*   destruct (a =? b) eqn:E1. *)
(*   - apply Reqb_eq in E1. constructor. auto. *)
(*   - apply Reqb_neq in E1. constructor. auto. *)
(* Defined. *)

(* ######################################################################### *)
(** * Examples which cannot automatically solved now *)

(** This example is occurred in the proof about Carg in Complex. *)
Goal forall a b r, a > 0 -> b <= r / a -> 0 <= r - b *a.
Proof.
  intros.
  ra. (* No effect *)
  apply Rmult_le_compat_r with (r:=a) in H0; ra.
  unfold Rdiv in H0. rewrite Rmult_assoc in H0.
  rewrite Rinv_l in H0; ra.
Qed.

(* ######################################################################### *)
(** * Temporarily added lemmas, need to be arranged to proper places *)

Lemma mult_PI_gt0 : forall r, 0 < r -> 0 < r * PI.
Proof.
  ra.
Qed.