Require Export Reals. Require Export Field. Require Export ZArith. Require Export Omega. Require Export ZArithRing. Require Export Wellfounded. Require Export Zwf. Require Export Fourier. Require Export List. Open Scope Z_scope. CoInductive stream (A:Set) : Set := Cons : A -> stream A -> stream A. Implicit Arguments Cons. Infix "::" := Cons :stream_scope. Delimit Scope stream_scope with S. Bind Scope stream_scope with stream. Open Scope stream_scope. Inductive idigit : Set := L | R | C. Open Scope R_scope. Definition alpha (d:idigit) : Rdefinitions.R := match d with L => 0 | C => 1/2 | R => 1 end. Definition lift (d:idigit)(x:Rdefinitions.R) := (x+alpha d)/2. CoInductive represents : stream idigit -> Rdefinitions.R -> Prop := repr : forall d s r, represents s r -> 0 <= r <= 1 -> represents (d::s) (lift d r). (* returns the interval represented by the n first digits of the stream, the value is given by (a, b, k) so that the interval actually is (a/(2**k), b/(2**k)) *) Close Scope R_scope. Fixpoint bounds (n:nat) (s:stream idigit) {struct n} : Z*Z*Z := match n with 0%nat => (0,1,0) | S p => let (d,tl) := s in let (p,e) := bounds p tl in let (a,b) := p in match d with L => (a,b,e+1) | R => (a+Zpower 2 e,b+Zpower 2 e,e+1) | C => (2*a+Zpower 2 e, 2*b+Zpower 2 e, e+2) end end. (* constructs the infinite stream representing a rational number. This function works even if the rational number is not between 0 and 1, but the value is meaningless. *) CoFixpoint rat_to_stream (a b:Z) : stream idigit := if Z_le_gt_dec (2*a) b then Cons L (rat_to_stream (2*a) b) else Cons R (rat_to_stream (2*a-b) b). (* A few constants. *) CoFixpoint one : stream idigit := R::one. CoFixpoint zero : stream idigit := L::zero. Definition half : stream idigit := R::zero. CoFixpoint third : stream idigit := L::R::third. Definition sixth : stream idigit := L::third. (* half_sum of two numbers. *) Definition help_type (d1 d2:stream idigit) := stream idigit. Definition help_type2 (d1 d2:stream idigit)(d3:idigit) := stream idigit. Ltac stream_length f := match f with Cons ?x ?f' => let v := stream_length f' in constr:(S v) | _ => constr:0%nat end. Ltac stream_tail f := match f with Cons ?x ?f' => f' | _ => f end. Ltac stream_end f := match f with Cons ?x ?f' => stream_end f' | _ => f end. Ltac mk_cases := match goal with |- help_type ?a ?b => let n1 := (stream_length a) in let n2 := (stream_length b) in let tl1 := (stream_end a) in let tl2 := (stream_end b) in let n3 := eval compute in (n1 - n2)%nat in let n4 := eval compute in (4 - (n1 + n2))%nat in match n4 with 0 => idtac "mk_cases failing"; fail | (S _) => match n3 with 0%nat => case tl1; intros [ | | ]; intro | (S _) => case tl2; intros [ | | ]; intro end end end. Ltac den s := let n := stream_length s in let b := eval compute in (bounds n s) in let r := eval compute in (2^(snd b))%Z in r. Ltac ub s := let n := stream_length s in let b := eval compute in (bounds n s) in let r := eval compute in (snd (fst b)) in r. Ltac lb s := let n := stream_length s in let b := eval compute in (bounds n s) in let r := eval compute in (fst (fst b)) in r. Ltac produce_add_cases := match goal with |- help_type ?u ?v => let bb1 := lb u in let bb2 := lb v in let tb1 := ub u in let tb2 := ub v in let d1 := den u in let d2 := den v in let test1 := eval compute in (bb1*d2 + bb2*d1 ?= d1*d2)%Z in let test2 := eval compute in (tb1*d2 + tb2*d1 ?= d1*d2)%Z in let test3 := eval compute in (2*(tb1*d2 + tb2*d1) ?= (3*(d1*d2)))%Z in let test4 := eval compute in (2*(bb1*d2 + bb2*d1) ?= d1*d2)%Z in match test1 with Gt => apply (Cons R); change (help_type2 u v R) | Eq => apply (Cons R); change (help_type2 u v R) | Lt => match test2 with Lt => apply (Cons L); change (help_type2 u v L) | Eq => apply (Cons L); change (help_type2 u v L) | Gt => match test3 with Gt => try (mk_cases; produce_add_cases) | _ => match test4 with Lt => try (mk_cases; produce_add_cases) | _ => apply (Cons C); try change (help_type2 u v C) end end end end end. CoFixpoint mult2 (x:stream idigit) : stream idigit := match x with R::_ => one | L::x' => x' | C::x' => R::mult2 x' end. Definition lbf (d:idigit) : Z := match d with L => 0 | R => 2 | C => 1 end. Definition compute_borrow (i1 i2 r :idigit) : Z := lbf i1 + lbf i2 - 2*lbf r. Ltac mk_borrow half_sum v s1 s2 := let mv := constr:(v,s1,s2) in match mv with | (-1, R::?tl1, ?tl2) => exact (half_sum (L::tl1) tl2) | (-1, ?tl1, R::?tl2) => exact (half_sum tl1 (L::tl2)) | (-1, C::?tl1, C::?tl2) => exact (half_sum (L::tl1) (L::tl2)) | (1, L::?tl1, ?tl2) => exact (half_sum (R::tl1) tl2) | (1, ?tl1, L::?tl2) => exact (half_sum tl1 (R::tl2)) | (1, C::?tl1, C::?tl2) => exact (half_sum (R::tl1) (R::tl2)) end. Definition half_sum (x y:stream idigit) : stream idigit. cofix. intros x y; change (help_type x y). produce_add_cases; match goal with |- help_type2 (?x::?tl1) (?y::?tl2) ?z => let r := eval compute in (compute_borrow x y z) in match r with 0 => exact (half_sum tl1 tl2) | _ => mk_borrow half_sum r tl1 tl2 end end. Defined. Definition add (x y:stream idigit) : stream idigit := mult2(half_sum x y). Infix "+" := add : stream_scope. Definition digit_sym (d:idigit) : idigit := match d with L => R | C => C | R => L end. CoFixpoint minus_aux (x:stream idigit) : stream idigit := let (d, x') := x in digit_sym d::minus_aux x'. CoFixpoint minus_half (x:stream idigit) : stream idigit := let (d, x') := x in match d with L => zero | R => L::x' | C => L::(minus_half x') end. Definition minus (x y:stream idigit) : stream idigit := minus_half(half_sum x (minus_aux y)). Definition series_body (A:Set) (series : stream idigit -> A -> stream idigit) (x : stream idigit) (a:A) : stream idigit := let (dig,x'') := x in match dig with R => R::series x'' a | L => match x'' with R::x3 => C::series (L::x3) a | _ => L::series x'' a end | C => match x'' with R::x3 => R::series (L::x3) a | _ => C::series x'' a end end. (* compute x + uw/4 *) CoFixpoint mult_a (x:stream idigit) (p:stream idigit*stream idigit) : stream idigit := let (u,v) := p in match u with L::u' => series_body _ mult_a x (u',v) | C::u' => series_body _ mult_a (x+(L::L::v)) (u',v) | R::u' => series_body _ mult_a (x+(L::v)) (u',v) end. Definition mult (x y:stream idigit) : stream idigit := mult2(mult2(mult_a zero (x,L::L::y))). Infix "*" := mult : stream_scope. Inductive triple : Set := mk_triple : stream idigit -> Z -> Z -> triple. Open Scope Z_scope. CoFixpoint e_series (x:stream idigit)(s :Z*Z*Z) :stream idigit := let (aux, theta) := s in let (y, n) := aux in let mu' := theta*(n-1) in let (v, phi, theta') := if Z_le_gt_dec (8*y) mu' then mk_triple x n theta else let theta' := mu'+theta in mk_triple (x+(rat_to_stream y theta'))(n+1) theta' in series_body _ e_series v (2*y, phi, theta'). Definition number_e_minus2 : stream idigit := e_series ((rat_to_stream 1 2)+(rat_to_stream 1 6)) (1, 4, 6). Close Scope Z_scope. Definition number_e_minus2_square : stream idigit := number_e_minus2 * number_e_minus2.