--- /dev/null
+(* ========================================================================= *)
+(* Grobner basis algorithm. *)
+(* ========================================================================= *)
+
+needs "Complex/complexnumbers.ml";;
+needs "Complex/quelim.ml";;
+
+prioritize_complex();;
+
+(* ------------------------------------------------------------------------- *)
+(* Utility functions. *)
+(* ------------------------------------------------------------------------- *)
+
+let allpairs f l1 l2 =
+ itlist ((@) o C map l2 o f) l1 [];;
+
+let rec merge ord l1 l2 =
+ match l1 with
+ [] -> l2
+ | h1::t1 -> match l2 with
+ [] -> l1
+ | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2)
+ else h2::(merge ord l1 t2);;
+
+let sort ord =
+ let rec mergepairs l1 l2 =
+ match (l1,l2) with
+ ([s],[]) -> s
+ | (l,[]) -> mergepairs [] l
+ | (l,[s1]) -> mergepairs (s1::l) []
+ | (l,(s1::s2::ss)) -> mergepairs ((merge ord s1 s2)::l) ss in
+ fun l -> if l = [] then [] else mergepairs [] (map (fun x -> [x]) l);;
+
+(* ------------------------------------------------------------------------- *)
+(* Type for recording history, i.e. how a polynomial was obtained. *)
+(* ------------------------------------------------------------------------- *)
+
+type history =
+ Start of int
+ | Mmul of (num * (int list)) * history
+ | Add of history * history;;
+
+(* ------------------------------------------------------------------------- *)
+(* Conversion of leaves, i.e. variables and constant rational constants. *)
+(* ------------------------------------------------------------------------- *)
+
+let grob_var vars tm =
+ let res = map (fun i -> if i = tm then 1 else 0) vars in
+ if exists (fun x -> x <> 0) res then [Int 1,res] else failwith "grob_var";;
+
+let grob_const =
+ let cx_tm = `Cx` in
+ fun vars tm ->
+ try let l,r = dest_comb tm in
+ if l = cx_tm then
+ let x = rat_of_term r in
+ if x =/ Int 0 then [] else [x,map (fun v -> 0) vars]
+ else failwith ""
+ with Failure _ -> failwith "grob_const";;
+
+(* ------------------------------------------------------------------------- *)
+(* Monomial ordering. *)
+(* ------------------------------------------------------------------------- *)
+
+let morder_lt =
+ let rec lexorder l1 l2 =
+ match (l1,l2) with
+ [],[] -> false
+ | (x1::o1,x2::o2) -> x1 > x2 or x1 = x2 & lexorder o1 o2
+ | _ -> failwith "morder: inconsistent monomial lengths" in
+ fun m1 m2 -> let n1 = itlist (+) m1 0
+ and n2 = itlist (+) m2 0 in
+ n1 < n2 or n1 = n2 & lexorder m1 m2;;
+
+let morder_le m1 m2 = morder_lt m1 m2 or (m1 = m2);;
+
+let morder_gt m1 m2 = morder_lt m2 m1;;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetic on canonical polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let grob_neg = map (fun (c,m) -> (minus_num c,m));;
+
+let rec grob_add l1 l2 =
+ match (l1,l2) with
+ ([],l2) -> l2
+ | (l1,[]) -> l1
+ | ((c1,m1)::o1,(c2,m2)::o2) ->
+ if m1 = m2 then
+ let c = c1+/c2 and rest = grob_add o1 o2 in
+ if c =/ Int 0 then rest else (c,m1)::rest
+ else if morder_lt m2 m1 then (c1,m1)::(grob_add o1 l2)
+ else (c2,m2)::(grob_add l1 o2);;
+
+let grob_sub l1 l2 = grob_add l1 (grob_neg l2);;
+
+let grob_mmul (c1,m1) (c2,m2) = (c1*/c2,map2 (+) m1 m2);;
+
+let rec grob_cmul cm pol = map (grob_mmul cm) pol;;
+
+let rec grob_mul l1 l2 =
+ match l1 with
+ [] -> []
+ | (h1::t1) -> grob_add (grob_cmul h1 l2) (grob_mul t1 l2);;
+
+let rec grob_pow vars l n =
+ if n < 0 then failwith "grob_pow: negative power"
+ else if n = 0 then [Int 1,map (fun v -> 0) vars]
+ else grob_mul l (grob_pow vars l (n - 1));;
+
+(* ------------------------------------------------------------------------- *)
+(* Monomial division operation. *)
+(* ------------------------------------------------------------------------- *)
+
+let mdiv (c1,m1) (c2,m2) =
+ (c1//c2,
+ map2 (fun n1 n2 -> if n1 < n2 then failwith "mdiv" else n1-n2) m1 m2);;
+
+(* ------------------------------------------------------------------------- *)
+(* Lowest common multiple of two monomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let mlcm (c1,m1) (c2,m2) = (Int 1,map2 max m1 m2);;
+
+(* ------------------------------------------------------------------------- *)
+(* Reduce monomial cm by polynomial pol, returning replacement for cm. *)
+(* ------------------------------------------------------------------------- *)
+
+let reduce1 cm (pol,hpol) =
+ match pol with
+ [] -> failwith "reduce1"
+ | cm1::cms -> try let (c,m) = mdiv cm cm1 in
+ (grob_cmul (minus_num c,m) cms,
+ Mmul((minus_num c,m),hpol))
+ with Failure _ -> failwith "reduce1";;
+
+(* ------------------------------------------------------------------------- *)
+(* Try this for all polynomials in a basis. *)
+(* ------------------------------------------------------------------------- *)
+
+let reduceb cm basis = tryfind (fun p -> reduce1 cm p) basis;;
+
+(* ------------------------------------------------------------------------- *)
+(* Reduction of a polynomial (always picking largest monomial possible). *)
+(* ------------------------------------------------------------------------- *)
+
+let rec reduce basis (pol,hist) =
+ match pol with
+ [] -> (pol,hist)
+ | cm::ptl -> try let q,hnew = reduceb cm basis in
+ reduce basis (grob_add q ptl,Add(hnew,hist))
+ with Failure _ ->
+ let q,hist' = reduce basis (ptl,hist) in
+ cm::q,hist';;
+
+(* ------------------------------------------------------------------------- *)
+(* Check for orthogonality w.r.t. LCM. *)
+(* ------------------------------------------------------------------------- *)
+
+let orthogonal l p1 p2 =
+ snd l = snd(grob_mmul (hd p1) (hd p2));;
+
+(* ------------------------------------------------------------------------- *)
+(* Compute S-polynomial of two polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let spoly cm ph1 ph2 =
+ match (ph1,ph2) with
+ ([],h),p -> ([],h)
+ | p,([],h) -> ([],h)
+ | (cm1::ptl1,his1),(cm2::ptl2,his2) ->
+ (grob_sub (grob_cmul (mdiv cm cm1) ptl1)
+ (grob_cmul (mdiv cm cm2) ptl2),
+ Add(Mmul(mdiv cm cm1,his1),
+ Mmul(mdiv (minus_num(fst cm),snd cm) cm2,his2)));;
+
+(* ------------------------------------------------------------------------- *)
+(* Make a polynomial monic. *)
+(* ------------------------------------------------------------------------- *)
+
+let monic (pol,hist) =
+ if pol = [] then (pol,hist) else
+ let c',m' = hd pol in
+ (map (fun (c,m) -> (c//c',m)) pol,
+ Mmul((Int 1 // c',map (K 0) m'),hist));;
+
+(* ------------------------------------------------------------------------- *)
+(* The most popular heuristic is to order critical pairs by LCM monomial. *)
+(* ------------------------------------------------------------------------- *)
+
+let forder ((c1,m1),_) ((c2,m2),_) = morder_lt m1 m2;;
+
+(* ------------------------------------------------------------------------- *)
+(* Stupid stuff forced on us by lack of equality test on num type. *)
+(* ------------------------------------------------------------------------- *)
+
+let rec poly_lt p q =
+ match (p,q) with
+ p,[] -> false
+ | [],q -> true
+ | (c1,m1)::o1,(c2,m2)::o2 ->
+ c1 </ c2 or
+ c1 =/ c2 & (m1 < m2 or m1 = m2 & poly_lt o1 o2);;
+
+let align ((p,hp),(q,hq)) =
+ if poly_lt p q then ((p,hp),(q,hq)) else ((q,hq),(p,hp));;
+
+let poly_eq p1 p2 =
+ forall2 (fun (c1,m1) (c2,m2) -> c1 =/ c2 & m1 = m2) p1 p2;;
+
+let memx ((p1,h1),(p2,h2)) ppairs =
+ not (exists (fun ((q1,_),(q2,_)) -> poly_eq p1 q1 & poly_eq p2 q2) ppairs);;
+
+(* ------------------------------------------------------------------------- *)
+(* Buchberger's second criterion. *)
+(* ------------------------------------------------------------------------- *)
+
+let criterion2 basis (lcm,((p1,h1),(p2,h2))) opairs =
+ exists (fun g -> not(poly_eq (fst g) p1) & not(poly_eq (fst g) p2) &
+ can (mdiv lcm) (hd(fst g)) &
+ not(memx (align(g,(p1,h1))) (map snd opairs)) &
+ not(memx (align(g,(p2,h2))) (map snd opairs))) basis;;
+
+(* ------------------------------------------------------------------------- *)
+(* Test for hitting constant polynomial. *)
+(* ------------------------------------------------------------------------- *)
+
+let constant_poly p =
+ length p = 1 & forall ((=) 0) (snd(hd p));;
+
+(* ------------------------------------------------------------------------- *)
+(* Grobner basis algorithm. *)
+(* ------------------------------------------------------------------------- *)
+
+let rec grobner histories basis pairs =
+ print_string(string_of_int(length basis)^" basis elements and "^
+ string_of_int(length pairs)^" critical pairs");
+ print_newline();
+ match pairs with
+ [] -> rev histories,basis
+ | (l,(p1,p2))::opairs ->
+ let (sp,hist) = monic (reduce basis (spoly l p1 p2)) in
+ if sp = [] or criterion2 basis (l,(p1,p2)) opairs
+ then grobner histories basis opairs else
+ let sph = sp,Start(length histories) in
+ if constant_poly sp
+ then grobner ((sp,hist)::histories) (sph::basis) [] else
+ let rawcps =
+ map (fun p -> mlcm (hd(fst p)) (hd sp),align(p,sph)) basis in
+ let newcps = filter
+ (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) rawcps in
+ grobner ((sp,hist)::histories) (sph::basis)
+ (merge forder opairs (sort forder newcps));;
+
+(* ------------------------------------------------------------------------- *)
+(* Overall function. *)
+(* ------------------------------------------------------------------------- *)
+
+let groebner pols =
+ let npols = map2 (fun p n -> p,Start n) pols (0--(length pols - 1)) in
+ let phists = filter (fun (p,_) -> p <> []) npols in
+ let bas0 = map monic phists in
+ let bas = map2 (fun (p,h) n -> p,Start n) bas0
+ ((length bas0)--(2 * length bas0 - 1)) in
+ let prs0 = allpairs (fun x y -> x,y) bas bas in
+ let prs1 = filter (fun ((x,_),(y,_)) -> poly_lt x y) prs0 in
+ let prs2 = map (fun (p,q) -> mlcm (hd(fst p)) (hd(fst q)),(p,q)) prs1 in
+ let prs3 = filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) prs2 in
+ grobner (rev bas0 @ rev phists) bas (mergesort forder prs3);;
+
+(* ------------------------------------------------------------------------- *)
+(* Alternative orthography. *)
+(* ------------------------------------------------------------------------- *)
+
+let gr'o'bner = groebner;;
+
+(* ------------------------------------------------------------------------- *)
+(* Conversion from HOL term. *)
+(* ------------------------------------------------------------------------- *)
+
+let grobify_term =
+ let neg_tm = `(--):complex->complex`
+ and add_tm = `(+):complex->complex->complex`
+ and sub_tm = `(-):complex->complex->complex`
+ and mul_tm = `(*):complex->complex->complex`
+ and pow_tm = `(pow):complex->num->complex` in
+ let rec grobify_term vars tm =
+ try grob_var vars tm with Failure _ ->
+ try grob_const vars tm with Failure _ ->
+ let lop,r = dest_comb tm in
+ if lop = neg_tm then grob_neg(grobify_term vars r) else
+ let op,l = dest_comb lop in
+ if op = pow_tm then
+ grob_pow vars (grobify_term vars l) (dest_small_numeral r)
+ else
+ (if op = add_tm then grob_add else if op = sub_tm then grob_sub
+ else if op = mul_tm then grob_mul else failwith "unknown term")
+ (grobify_term vars l) (grobify_term vars r) in
+ fun vars tm ->
+ try grobify_term vars tm with Failure _ -> failwith "grobify_term";;
+
+let grobvars =
+ let neg_tm = `(--):complex->complex`
+ and add_tm = `(+):complex->complex->complex`
+ and sub_tm = `(-):complex->complex->complex`
+ and mul_tm = `(*):complex->complex->complex`
+ and pow_tm = `(pow):complex->num->complex` in
+ let rec grobvars tm acc =
+ if is_complex_const tm then acc
+ else if not (is_comb tm) then tm::acc else
+ let lop,r = dest_comb tm in
+ if lop = neg_tm then grobvars r acc
+ else if not (is_comb lop) then tm::acc else
+ let op,l = dest_comb lop in
+ if op = pow_tm then grobvars l acc
+ else if op = mul_tm or op = sub_tm or op = add_tm
+ then grobvars l (grobvars r acc)
+ else tm::acc in
+ fun tm -> setify(grobvars tm []);;
+
+let grobify_equations =
+ let zero_tm = `Cx(&0)`
+ and sub_tm = `(-):complex->complex->complex`
+ and complex_ty = `:complex` in
+ let grobify_equation vars tm =
+ let l,r = dest_eq tm in
+ if r <> zero_tm then grobify_term vars (mk_comb(mk_comb(sub_tm,l),r))
+ else grobify_term vars l in
+ fun tm ->
+ let cjs = conjuncts tm in
+ let rawvars = itlist
+ (fun eq acc -> let l,r = dest_eq eq in
+ union (union (grobvars l) (grobvars r)) acc) cjs [] in
+ let vars = sort (fun x y -> x < y) rawvars in
+ vars,map(grobify_equation vars) cjs;;
+
+(* ------------------------------------------------------------------------- *)
+(* Printer. *)
+(* ------------------------------------------------------------------------- *)
+
+let string_of_monomial vars (c,m) =
+ let xns = filter (fun (x,y) -> y <> 0) (map2 (fun x y -> x,y) vars m) in
+ let xnstrs = map
+ (fun (x,n) -> x^(if n = 1 then "" else "^"^(string_of_int n))) xns in
+ if xns = [] then Num.string_of_num c else
+ let basstr = if c =/ Int 1 then "" else (Num.string_of_num c)^" * " in
+ basstr ^ end_itlist (fun s t -> s^" * "^t) xnstrs;;
+
+let string_of_polynomial vars l =
+ if l = [] then "0" else
+ end_itlist (fun s t -> s^" + "^t) (map (string_of_monomial vars) l);;
+
+(* ------------------------------------------------------------------------- *)
+(* Resolve a proof. *)
+(* ------------------------------------------------------------------------- *)
+
+let rec resolve_proof vars prf =
+ match prf with
+ Start n ->
+ [n,[Int 1,map (K 0) vars]]
+ | Mmul(pol,lin) ->
+ let lis = resolve_proof vars lin in
+ map (fun (n,p) -> n,grob_cmul pol p) lis
+ | Add(lin1,lin2) ->
+ let lis1 = resolve_proof vars lin1
+ and lis2 = resolve_proof vars lin2 in
+ let dom = setify(union (map fst lis1) (map fst lis2)) in
+ map (fun n -> let a = try assoc n lis1 with Failure _ -> []
+ and b = try assoc n lis2 with Failure _ -> [] in
+ n,grob_add a b) dom;;
+
+(* ------------------------------------------------------------------------- *)
+(* Convert a polynomial back to HOL. *)
+(* ------------------------------------------------------------------------- *)
+
+let holify_polynomial =
+ let complex_ty = `:complex`
+ and pow_tm = `(pow):complex->num->complex`
+ and mk_mul = mk_binop `(*):complex->complex->complex`
+ and mk_add = mk_binop `(+):complex->complex->complex`
+ and zero_tm = `Cx(&0)`
+ and add_tm = `(+):complex->complex->complex`
+ and mul_tm = `(*):complex->complex->complex`
+ and complex_term_of_rat = curry mk_comb `Cx` o term_of_rat in
+ let holify_varpow (v,n) =
+ if n = 1 then v
+ else list_mk_comb(pow_tm,[v;mk_small_numeral n]) in
+ let holify_monomial vars (c,m) =
+ let xps = map holify_varpow (filter (fun (_,n) -> n <> 0) (zip vars m)) in
+ end_itlist mk_mul (complex_term_of_rat c :: xps) in
+ let holify_polynomial vars p =
+ if p = [] then zero_tm
+ else end_itlist mk_add (map (holify_monomial vars) p) in
+ holify_polynomial;;
+
+(* ------------------------------------------------------------------------- *)
+(* Recursively find the set of basis elements involved. *)
+(* ------------------------------------------------------------------------- *)
+
+let dependencies =
+ let rec dependencies prf acc =
+ match prf with
+ Start n -> n::acc
+ | Mmul(pol,lin) -> dependencies lin acc
+ | Add(lin1,lin2) -> dependencies lin1 (dependencies lin2 acc) in
+ fun prf -> setify(dependencies prf []);;
+
+let rec involved deps sofar todo =
+ match todo with
+ [] -> sort (<) sofar
+ | (h::hs) ->
+ if mem h sofar then involved deps sofar hs
+ else involved deps (h::sofar) (el h deps @ hs);;
+
+(* ------------------------------------------------------------------------- *)
+(* Refute a conjunction of equations in HOL. *)
+(* ------------------------------------------------------------------------- *)
+
+let GROBNER_REFUTE =
+ let add_tm = `(+):complex->complex->complex`
+ and mul_tm = `(*):complex->complex->complex` in
+ let APPLY_pth = MATCH_MP(SIMPLE_COMPLEX_ARITH
+ `(x = y) ==> (x + Cx(--(&1)) * (y + Cx(&1)) = Cx(&0)) ==> F`)
+ and MK_ADD th1 th2 = MK_COMB(AP_TERM add_tm th1,th2) in
+ let rec holify_lincombs vars cjs prfs =
+ match prfs with
+ [] -> cjs
+ | (p::ps) ->
+ if p = [] then holify_lincombs vars (cjs @ [TRUTH]) ps else
+ let holis = map (fun (n,q) -> n,holify_polynomial vars q) p in
+ let ths =
+ map (fun (n,m) -> AP_TERM (mk_comb(mul_tm,m)) (el n cjs)) holis in
+ let th = CONV_RULE(BINOP_CONV COMPLEX_POLY_CONV)
+ (end_itlist MK_ADD ths) in
+ holify_lincombs vars (cjs @ [th]) ps in
+ fun tm ->
+ let vars,pols = grobify_equations tm in
+ let (prfs,gb) = groebner pols in
+ let (_,prf) =
+ find (fun (p,h) -> length p = 1 & forall ((=)0) (snd(hd p))) gb in
+ let deps = map (dependencies o snd) prfs
+ and depl = dependencies prf in
+ let need = involved deps [] depl in
+ let pprfs =
+ map2 (fun p n -> if mem n need then resolve_proof vars (snd p) else [])
+ prfs (0--(length prfs - 1))
+ and ppr = resolve_proof vars prf in
+ let ths = CONJUNCTS(ASSUME tm) in
+ let th = last
+ (holify_lincombs vars ths (snd(chop_list(length ths) (pprfs @ [ppr])))) in
+ CONV_RULE COMPLEX_RAT_EQ_CONV th;;
+
+(* ------------------------------------------------------------------------- *)
+(* Overall conversion. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_ARITH =
+ let pth0 = SIMPLE_COMPLEX_ARITH `(x = y) <=> (x - y = Cx(&0))`
+ and pth1 = prove
+ (`!x. ~(x = Cx(&0)) <=> ?z. z * x + Cx(&1) = Cx(&0)`,
+ CONV_TAC(time FULL_COMPLEX_QUELIM_CONV))
+ and pth2a = prove
+ (`!x y u v. ~(x = y) \/ ~(u = v) <=>
+ ?w z. w * (x - y) + z * (u - v) + Cx(&1) = Cx(&0)`,
+ CONV_TAC(time FULL_COMPLEX_QUELIM_CONV))
+ and pth2b = prove
+ (`!x y. ~(x = y) <=> ?z. z * (x - y) + Cx(&1) = Cx(&0)`,
+ CONV_TAC(time FULL_COMPLEX_QUELIM_CONV))
+ and pth3 = TAUT `(p ==> F) ==> (~q <=> p) ==> q` in
+ let GEN_PRENEX_CONV =
+ GEN_REWRITE_CONV REDEPTH_CONV
+ [AND_FORALL_THM;
+ LEFT_AND_FORALL_THM;
+ RIGHT_AND_FORALL_THM;
+ LEFT_OR_FORALL_THM;
+ RIGHT_OR_FORALL_THM;
+ OR_EXISTS_THM;
+ LEFT_OR_EXISTS_THM;
+ RIGHT_OR_EXISTS_THM;
+ LEFT_AND_EXISTS_THM;
+ RIGHT_AND_EXISTS_THM] in
+ let INITIAL_CONV =
+ NNF_CONV THENC
+ GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth1] THENC
+ GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth2a] THENC
+ GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth2b] THENC
+ ONCE_DEPTH_CONV(GEN_REWRITE_CONV I [pth0] o
+ check ((<>) `Cx(&0)` o rand)) THENC
+ GEN_PRENEX_CONV THENC
+ DNF_CONV in
+ fun tm ->
+ let avs = frees tm in
+ let tm' = list_mk_forall(avs,tm) in
+ let th1 = INITIAL_CONV(mk_neg tm') in
+ let evs,bod = strip_exists(rand(concl th1)) in
+ if is_forall bod then failwith "COMPLEX_ARITH: non-universal formula" else
+ let djs = disjuncts bod in
+ let th2 = end_itlist SIMPLE_DISJ_CASES(map GROBNER_REFUTE djs) in
+ let th3 = itlist SIMPLE_CHOOSE evs th2 in
+ SPECL avs (MATCH_MP (MATCH_MP pth3 (DISCH_ALL th3)) th1);;
--- /dev/null
+(* ========================================================================= *)
+(* Trivial restriction of complex Groebner bases to reals. *)
+(* ========================================================================= *)
+
+let GROBNER_REAL_ARITH =
+ let trans_conv = GEN_REWRITE_CONV TOP_SWEEP_CONV
+ [GSYM CX_INJ; CX_POW; CX_MUL; CX_ADD; CX_NEG; CX_SUB] in
+ fun tm -> let th = trans_conv tm in
+ EQ_MP (SYM th) (COMPLEX_ARITH(rand(concl th)));;
--- /dev/null
+(* ========================================================================= *)
+(* Complex transcendental functions. *)
+(* ========================================================================= *)
+
+needs "Library/transc.ml";;
+needs "Library/floor.ml";;
+needs "Complex/complexnumbers.ml";;
+
+unparse_as_infix "exp";;
+remove_interface "exp";;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex square roots. *)
+(* ------------------------------------------------------------------------- *)
+
+let csqrt = new_definition
+ `csqrt(z) = if Im(z) = &0 then
+ if &0 <= Re(z) then complex(sqrt(Re(z)),&0)
+ else complex(&0,sqrt(--Re(z)))
+ else complex(sqrt((norm(z) + Re(z)) / &2),
+ (Im(z) / abs(Im(z))) *
+ sqrt((norm(z) - Re(z)) / &2))`;;
+
+let COMPLEX_NORM_GE_RE_IM = prove
+ (`!z. abs(Re(z)) <= norm(z) /\ abs(Im(z)) <= norm(z)`,
+ GEN_TAC THEN ONCE_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN
+ REWRITE_TAC[complex_norm] THEN
+ CONJ_TAC THEN
+ MATCH_MP_TAC SQRT_MONO_LE THEN
+ ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_ADDL; REAL_POW_2; REAL_LE_SQUARE]);;
+
+let CSQRT = prove
+ (`!z. csqrt(z) pow 2 = z`,
+ GEN_TAC THEN REWRITE_TAC[COMPLEX_POW_2; csqrt] THEN COND_CASES_TAC THENL
+ [COND_CASES_TAC THEN
+ ASM_REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_RZERO; REAL_MUL_LZERO;
+ REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_ADD_LID; COMPLEX_EQ] THEN
+ REWRITE_TAC[REAL_NEG_EQ; GSYM REAL_POW_2] THEN
+ ASM_SIMP_TAC[SQRT_POW_2; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`];
+ ALL_TAC] THEN
+ REWRITE_TAC[complex_mul; RE; IM] THEN
+ ONCE_REWRITE_TAC[REAL_ARITH
+ `(s * s - (i * s') * (i * s') = s * s - (i * i) * (s' * s')) /\
+ (s * i * s' + (i * s')* s = &2 * i * s * s')`] THEN
+ REWRITE_TAC[GSYM REAL_POW_2] THEN
+ SUBGOAL_THEN `&0 <= norm(z) + Re(z) /\ &0 <= norm(z) - Re(z)`
+ STRIP_ASSUME_TAC THENL
+ [MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC;
+ ALL_TAC] THEN
+ ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; GSYM SQRT_MUL; SQRT_POW_2] THEN
+ REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN CONJ_TAC THENL
+ [ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW2_ABS;
+ REAL_POW_EQ_0; REAL_DIV_REFL] THEN
+ REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_SUB_RDISTRIB] THEN
+ REWRITE_TAC[REAL_ARITH `(m + r) - (m - r) = r * &2`] THEN
+ REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
+ REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN
+ REWRITE_TAC[real_div] THEN
+ ONCE_REWRITE_TAC[AC REAL_MUL_AC
+ `(a * b) * a' * b = (a * a') * (b * b:real)`] THEN
+ REWRITE_TAC[REAL_DIFFSQ] THEN
+ REWRITE_TAC[complex_norm; GSYM REAL_POW_2] THEN
+ SIMP_TAC[SQRT_POW_2; REAL_LE_ADD;
+ REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE] THEN
+ REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_POW_MUL] THEN
+ REWRITE_TAC[POW_2_SQRT_ABS] THEN
+ REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
+ ONCE_REWRITE_TAC[AC REAL_MUL_AC
+ `&2 * (i * a') * a * h = i * (&2 * h) * a * a'`] THEN
+ CONV_TAC REAL_RAT_REDUCE_CONV THEN
+ REWRITE_TAC[REAL_MUL_LID; GSYM real_div] THEN
+ ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ABS_ZERO; REAL_MUL_RID]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex exponential. *)
+(* ------------------------------------------------------------------------- *)
+
+let cexp = new_definition
+ `cexp z = Cx(exp(Re z)) * complex(cos(Im z),sin(Im z))`;;
+
+let CX_CEXP = prove
+ (`!x. Cx(exp x) = cexp(Cx x)`,
+ REWRITE_TAC[cexp; CX_DEF; RE; IM; SIN_0; COS_0] THEN
+ REWRITE_TAC[GSYM CX_DEF; GSYM CX_MUL; REAL_MUL_RID]);;
+
+let CEXP_0 = prove
+ (`cexp(Cx(&0)) = Cx(&1)`,
+ REWRITE_TAC[GSYM CX_CEXP; REAL_EXP_0]);;
+
+let CEXP_ADD = prove
+ (`!w z. cexp(w + z) = cexp(w) * cexp(z)`,
+ REWRITE_TAC[COMPLEX_EQ; cexp; complex_mul; complex_add; RE; IM; CX_DEF] THEN
+ REWRITE_TAC[REAL_EXP_ADD; SIN_ADD; COS_ADD] THEN CONV_TAC REAL_RING);;
+
+let CEXP_MUL = prove
+ (`!n z. cexp(Cx(&n) * z) = cexp(z) pow n`,
+ INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN
+ REWRITE_TAC[COMPLEX_MUL_LZERO; CEXP_0] THEN
+ REWRITE_TAC[GSYM REAL_OF_NUM_SUC; COMPLEX_ADD_RDISTRIB; CX_ADD] THEN
+ ASM_REWRITE_TAC[CEXP_ADD; COMPLEX_MUL_LID] THEN
+ REWRITE_TAC[COMPLEX_MUL_AC]);;
+
+let CEXP_NONZERO = prove
+ (`!z. ~(cexp z = Cx(&0))`,
+ GEN_TAC THEN REWRITE_TAC[cexp; COMPLEX_ENTIRE; CX_INJ; REAL_EXP_NZ] THEN
+ REWRITE_TAC[CX_DEF; RE; IM; COMPLEX_EQ] THEN
+ MP_TAC(SPEC `Im z` SIN_CIRCLE) THEN CONV_TAC REAL_RING);;
+
+let CEXP_NEG_LMUL = prove
+ (`!z. cexp(--z) * cexp(z) = Cx(&1)`,
+ REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_ADD_LINV; CEXP_0]);;
+
+let CEXP_NEG_RMUL = prove
+ (`!z. cexp(z) * cexp(--z) = Cx(&1)`,
+ REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_ADD_RINV; CEXP_0]);;
+
+let CEXP_NEG = prove
+ (`!z. cexp(--z) = inv(cexp z)`,
+ MESON_TAC[CEXP_NEG_LMUL; COMPLEX_MUL_LINV_UNIQ]);;
+
+let CEXP_SUB = prove
+ (`!w z. cexp(w - z) = cexp(w) / cexp(z)`,
+ REWRITE_TAC[complex_sub; complex_div; CEXP_NEG; CEXP_ADD]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex trig functions. *)
+(* ------------------------------------------------------------------------- *)
+
+let ccos = new_definition
+ `ccos z = (cexp(ii * z) + cexp(--ii * z)) / Cx(&2)`;;
+
+let csin = new_definition
+ `csin z = (cexp(ii * z) - cexp(--ii * z)) / (Cx(&2) * ii)`;;
+
+let CX_CSIN,CX_CCOS = (CONJ_PAIR o prove)
+ (`(!x. Cx(sin x) = csin(Cx x)) /\ (!x. Cx(cos x) = ccos(Cx x))`,
+ REWRITE_TAC[csin; ccos; cexp; CX_DEF; ii; RE; IM; complex_mul; complex_add;
+ REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_SUB_RZERO;
+ REAL_MUL_LID; complex_neg; REAL_EXP_0; REAL_ADD_LID;
+ REAL_MUL_LNEG; REAL_NEG_0; REAL_ADD_RID; complex_sub;
+ SIN_NEG; COS_NEG; GSYM REAL_MUL_2; GSYM real_sub;
+ complex_div; REAL_SUB_REFL; complex_inv; REAL_SUB_RNEG] THEN
+ CONJ_TAC THEN GEN_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
+ REWRITE_TAC[REAL_MUL_RZERO] THEN
+ AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC REAL_RING);;
+
+let CSIN_0 = prove
+ (`csin(Cx(&0)) = Cx(&0)`,
+ REWRITE_TAC[GSYM CX_CSIN; SIN_0]);;
+
+let CCOS_0 = prove
+ (`ccos(Cx(&0)) = Cx(&1)`,
+ REWRITE_TAC[GSYM CX_CCOS; COS_0]);;
+
+let CSIN_CIRCLE = prove
+ (`!z. csin(z) pow 2 + ccos(z) pow 2 = Cx(&1)`,
+ GEN_TAC THEN REWRITE_TAC[csin; ccos] THEN
+ MP_TAC(SPEC `ii * z` CEXP_NEG_LMUL) THEN
+ MP_TAC COMPLEX_POW_II_2 THEN REWRITE_TAC[COMPLEX_MUL_LNEG] THEN
+ CONV_TAC COMPLEX_FIELD);;
+
+let CSIN_ADD = prove
+ (`!w z. csin(w + z) = csin(w) * ccos(z) + ccos(w) * csin(z)`,
+ REPEAT GEN_TAC THEN
+ REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN
+ MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);;
+
+let CCOS_ADD = prove
+ (`!w z. ccos(w + z) = ccos(w) * ccos(z) - csin(w) * csin(z)`,
+ REPEAT GEN_TAC THEN
+ REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN
+ MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);;
+
+let CSIN_NEG = prove
+ (`!z. csin(--z) = --(csin(z))`,
+ REWRITE_TAC[csin; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN
+ GEN_TAC THEN MP_TAC COMPLEX_POW_II_2 THEN
+ CONV_TAC COMPLEX_FIELD);;
+
+let CCOS_NEG = prove
+ (`!z. ccos(--z) = ccos(z)`,
+ REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN
+ GEN_TAC THEN MP_TAC COMPLEX_POW_II_2 THEN
+ CONV_TAC COMPLEX_FIELD);;
+
+let CSIN_DOUBLE = prove
+ (`!z. csin(Cx(&2) * z) = Cx(&2) * csin(z) * ccos(z)`,
+ REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CSIN_ADD] THEN
+ CONV_TAC COMPLEX_RING);;
+
+let CCOS_DOUBLE = prove
+ (`!z. ccos(Cx(&2) * z) = (ccos(z) pow 2) - (csin(z) pow 2)`,
+ REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN
+ CONV_TAC COMPLEX_RING);;
+
+(* ------------------------------------------------------------------------- *)
+(* Euler and de Moivre formulas. *)
+(* ------------------------------------------------------------------------- *)
+
+let CEXP_EULER = prove
+ (`!z. cexp(ii * z) = ccos(z) + ii * csin(z)`,
+ REWRITE_TAC[ccos; csin] THEN MP_TAC COMPLEX_POW_II_2 THEN
+ CONV_TAC COMPLEX_FIELD);;
+
+let DEMOIVRE = prove
+ (`!z n. (ccos z + ii * csin z) pow n =
+ ccos(Cx(&n) * z) + ii * csin(Cx(&n) * z)`,
+ REWRITE_TAC[GSYM CEXP_EULER; GSYM CEXP_MUL] THEN
+ REWRITE_TAC[COMPLEX_MUL_AC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Some lemmas. *)
+(* ------------------------------------------------------------------------- *)
+
+let EXISTS_COMPLEX = prove
+ (`!P. (?z. P (Re z) (Im z)) <=> ?x y. P x y`,
+ MESON_TAC[RE; IM; COMPLEX]);;
+
+let COMPLEX_UNIMODULAR_POLAR = prove
+ (`!z. (norm z = &1) ==> ?x. z = complex(cos(x),sin(x))`,
+ GEN_TAC THEN
+ DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow):real->num->real`) THEN
+ REWRITE_TAC[complex_norm] THEN
+ SIMP_TAC[REAL_POW_2; REWRITE_RULE[REAL_POW_2] SQRT_POW_2;
+ REAL_LE_SQUARE; REAL_LE_ADD] THEN
+ REWRITE_TAC[GSYM REAL_POW_2; REAL_MUL_LID] THEN
+ DISCH_THEN(X_CHOOSE_TAC `t:real` o MATCH_MP CIRCLE_SINCOS) THEN
+ EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM]);;
+
+let SIN_INTEGER_2PI = prove
+ (`!n. integer n ==> sin((&2 * pi) * n) = &0`,
+ REWRITE_TAC[integer; REAL_ARITH `abs(x) = &n <=> x = &n \/ x = -- &n`] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; SIN_NEG] THEN
+ REWRITE_TAC[GSYM REAL_MUL_ASSOC; SIN_DOUBLE] THEN
+ REWRITE_TAC[REAL_ARITH `pi * &n = &n * pi`; SIN_NPI] THEN
+ REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_NEG_0]);;
+
+let COS_INTEGER_2PI = prove
+ (`!n. integer n ==> cos((&2 * pi) * n) = &1`,
+ REWRITE_TAC[integer; REAL_ARITH `abs(x) = &n <=> x = &n \/ x = -- &n`] THEN
+ REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; COS_NEG] THEN
+ REWRITE_TAC[GSYM REAL_MUL_ASSOC; COS_DOUBLE] THEN
+ REWRITE_TAC[REAL_ARITH `pi * &n = &n * pi`; SIN_NPI; COS_NPI] THEN
+ REWRITE_TAC[REAL_POW_POW] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
+ REWRITE_TAC[GSYM REAL_POW_POW; REAL_POW_2] THEN
+ CONV_TAC REAL_RAT_REDUCE_CONV THEN
+ REWRITE_TAC[REAL_POW_ONE; REAL_SUB_RZERO]);;
+
+let SINCOS_PRINCIPAL_VALUE = prove
+ (`!x. ?y. (--pi < y /\ y <= pi) /\ (sin(y) = sin(x) /\ cos(y) = cos(x))`,
+ GEN_TAC THEN EXISTS_TAC `pi - (&2 * pi) * frac((pi - x) / (&2 * pi))` THEN
+ CONJ_TAC THENL
+ [SIMP_TAC[REAL_ARITH `--p < p - x <=> x < (&2 * p) * &1`;
+ REAL_ARITH `p - x <= p <=> (&2 * p) * &0 <= x`;
+ REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_LT_MUL;
+ PI_POS; REAL_OF_NUM_LT; ARITH; FLOOR_FRAC];
+ REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LDISTRIB] THEN
+ SIMP_TAC[REAL_DIV_LMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ;
+ PI_POS; REAL_ARITH `a - (a - b - c):real = b + c`; SIN_ADD; COS_ADD] THEN
+ SIMP_TAC[FLOOR_FRAC; SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN
+ CONV_TAC REAL_RING]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex logarithms (the conventional principal value). *)
+(* ------------------------------------------------------------------------- *)
+
+let clog = new_definition
+ `clog z = @w. cexp(w) = z /\ --pi < Im(w) /\ Im(w) <= pi`;;
+
+let CLOG_WORKS = prove
+ (`!z. ~(z = Cx(&0))
+ ==> cexp(clog z) = z /\ --pi < Im(clog z) /\ Im(clog z) <= pi`,
+ GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[clog] THEN CONV_TAC SELECT_CONV THEN
+ REWRITE_TAC[cexp; EXISTS_COMPLEX] THEN
+ EXISTS_TAC `ln(norm(z:complex))` THEN
+ SUBGOAL_THEN `exp(ln(norm(z:complex))) = norm(z)` SUBST1_TAC THENL
+ [ASM_MESON_TAC[REAL_EXP_LN; COMPLEX_NORM_NZ]; ALL_TAC] THEN
+ MP_TAC(SPEC `z / Cx(norm z)` COMPLEX_UNIMODULAR_POLAR) THEN ANTS_TAC THENL
+ [ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN
+ ASM_SIMP_TAC[COMPLEX_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO];
+ ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
+ MP_TAC(SPEC `x:real` SINCOS_PRINCIPAL_VALUE) THEN
+ MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real` THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ ASM_MESON_TAC[CX_INJ; COMPLEX_DIV_LMUL; COMPLEX_NORM_ZERO]);;
+
+let CEXP_CLOG = prove
+ (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z`,
+ SIMP_TAC[CLOG_WORKS]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Unwinding number. *)
+(* ------------------------------------------------------------------------- *)
+
+let unwinding = new_definition
+ `unwinding(z) = (z - clog(cexp z)) / (Cx(&2 * pi) * ii)`;;
+
+let COMPLEX_II_NZ = prove
+ (`~(ii = Cx(&0))`,
+ MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_RING);;
+
+let UNWINDING_2PI = prove
+ (`Cx(&2 * pi) * ii * unwinding(z) = z - clog(cexp z)`,
+ REWRITE_TAC[unwinding; COMPLEX_MUL_ASSOC] THEN
+ MATCH_MP_TAC COMPLEX_DIV_LMUL THEN
+ REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; COMPLEX_II_NZ] THEN
+ MP_TAC PI_POS THEN REAL_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* An example of how to get nice identities with unwinding number. *)
+(* ------------------------------------------------------------------------- *)
+
+let CLOG_MUL = prove
+ (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0))
+ ==> clog(w * z) =
+ clog(w) + clog(z) -
+ Cx(&2 * pi) * ii * unwinding(clog w + clog z)`,
+ REWRITE_TAC[UNWINDING_2PI;
+ COMPLEX_RING `w + z - ((w + z) - c) = c:complex`] THEN
+ ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG]);;
--- /dev/null
+(* ========================================================================= *)
+(* Basic definitions and properties of complex numbers. *)
+(* ========================================================================= *)
+
+needs "Library/transc.ml";;
+
+prioritize_real();;
+
+(* ------------------------------------------------------------------------- *)
+(* Definition of complex number type. *)
+(* ------------------------------------------------------------------------- *)
+
+let complex_tybij_raw =
+ new_type_definition "complex" ("complex","coords")
+ (prove(`?x:real#real. T`,REWRITE_TAC[]));;
+
+let complex_tybij = REWRITE_RULE [] complex_tybij_raw;;
+
+(* ------------------------------------------------------------------------- *)
+(* Real and imaginary parts of a number. *)
+(* ------------------------------------------------------------------------- *)
+
+let RE_DEF = new_definition
+ `Re(z) = FST(coords(z))`;;
+
+let IM_DEF = new_definition
+ `Im(z) = SND(coords(z))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Set up overloading. *)
+(* ------------------------------------------------------------------------- *)
+
+do_list overload_interface
+ ["+",`complex_add:complex->complex->complex`;
+ "-",`complex_sub:complex->complex->complex`;
+ "*",`complex_mul:complex->complex->complex`;
+ "/",`complex_div:complex->complex->complex`;
+ "--",`complex_neg:complex->complex`;
+ "pow",`complex_pow:complex->num->complex`;
+ "inv",`complex_inv:complex->complex`];;
+
+let prioritize_complex() = prioritize_overload(mk_type("complex",[]));;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex absolute value (modulus). *)
+(* ------------------------------------------------------------------------- *)
+
+make_overloadable "norm" `:A->real`;;
+overload_interface("norm",`complex_norm:complex->real`);;
+
+let complex_norm = new_definition
+ `norm(z) = sqrt(Re(z) pow 2 + Im(z) pow 2)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Imaginary unit (too inconvenient to use "i"!) *)
+(* ------------------------------------------------------------------------- *)
+
+let ii = new_definition
+ `ii = complex(&0,&1)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Injection from reals. *)
+(* ------------------------------------------------------------------------- *)
+
+let CX_DEF = new_definition
+ `Cx(a) = complex(a,&0)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetic operations. *)
+(* ------------------------------------------------------------------------- *)
+
+let complex_neg = new_definition
+ `--z = complex(--(Re(z)),--(Im(z)))`;;
+
+let complex_add = new_definition
+ `w + z = complex(Re(w) + Re(z),Im(w) + Im(z))`;;
+
+let complex_sub = new_definition
+ `w - z = w + --z`;;
+
+let complex_mul = new_definition
+ `w * z = complex(Re(w) * Re(z) - Im(w) * Im(z),
+ Re(w) * Im(z) + Im(w) * Re(z))`;;
+
+let complex_inv = new_definition
+ `inv(z) = complex(Re(z) / (Re(z) pow 2 + Im(z) pow 2),
+ --(Im(z)) / (Re(z) pow 2 + Im(z) pow 2))`;;
+
+let complex_div = new_definition
+ `w / z = w * inv(z)`;;
+
+let complex_pow = new_recursive_definition num_RECURSION
+ `(x pow 0 = Cx(&1)) /\
+ (!n. x pow (SUC n) = x * x pow n)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Various handy rewrites. *)
+(* ------------------------------------------------------------------------- *)
+
+let RE = prove
+ (`(Re(complex(x,y)) = x)`,
+ REWRITE_TAC[RE_DEF; complex_tybij]);;
+
+let IM = prove
+ (`Im(complex(x,y)) = y`,
+ REWRITE_TAC[IM_DEF; complex_tybij]);;
+
+let COMPLEX = prove
+ (`complex(Re(z),Im(z)) = z`,
+ REWRITE_TAC[IM_DEF; RE_DEF; complex_tybij]);;
+
+let COMPLEX_EQ = prove
+ (`!w z. (w = z) <=> (Re(w) = Re(z)) /\ (Im(w) = Im(z))`,
+ REWRITE_TAC[RE_DEF; IM_DEF; GSYM PAIR_EQ] THEN MESON_TAC[complex_tybij]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Crude tactic to automate very simple algebraic equivalences. *)
+(* ------------------------------------------------------------------------- *)
+
+let SIMPLE_COMPLEX_ARITH_TAC =
+ REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF;
+ complex_add; complex_neg; complex_sub; complex_mul] THEN
+ REAL_ARITH_TAC;;
+
+let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Basic algebraic properties that can be proved automatically by this. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_ADD_SYM = prove
+ (`!x y. x + y = y + x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_ASSOC = prove
+ (`!x y z. x + y + z = (x + y) + z`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_LID = prove
+ (`!x. Cx(&0) + x = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_LINV = prove
+ (`!x. --x + x = Cx(&0)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_SYM = prove
+ (`!x y. x * y = y * x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_ASSOC = prove
+ (`!x y z. x * y * z = (x * y) * z`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_LID = prove
+ (`!x. Cx(&1) * x = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_LDISTRIB = prove
+ (`!x y z. x * (y + z) = x * y + x * z`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_AC = prove
+ (`(m + n = n + m) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_AC = prove
+ (`(m * n = n * m) /\ ((m * n) * p = m * n * p) /\ (m * n * p = n * m * p)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_RID = prove
+ (`!x. x + Cx(&0) = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_RID = prove
+ (`!x. x * Cx(&1) = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_RINV = prove
+ (`!x. x + --x = Cx(&0)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_RDISTRIB = prove
+ (`!x y z. (x + y) * z = x * z + y * z`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_ADD_LCANCEL = prove
+ (`!x y z. (x + y = x + z) <=> (y = z)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_ADD_RCANCEL = prove
+ (`!x y z. (x + z = y + z) <=> (x = y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_RZERO = prove
+ (`!x. x * Cx(&0) = Cx(&0)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_LZERO = prove
+ (`!x. Cx(&0) * x = Cx(&0)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_NEG = prove
+ (`!x. --(--x) = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_RNEG = prove
+ (`!x y. x * --y = --(x * y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_LNEG = prove
+ (`!x y. --x * y = --(x * y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_ADD = prove
+ (`!x y. --(x + y) = --x + --y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_0 = prove
+ (`--Cx(&0) = Cx(&0)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_ADD_LCANCEL_0 = prove
+ (`!x y. (x + y = x) <=> (y = Cx(&0))`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_ADD_RCANCEL_0 = prove
+ (`!x y. (x + y = y) <=> (x = Cx(&0))`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_LNEG_UNIQ = prove
+ (`!x y. (x + y = Cx(&0)) <=> (x = --y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_RNEG_UNIQ = prove
+ (`!x y. (x + y = Cx(&0)) <=> (y = --x)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_LMUL = prove
+ (`!x y. --(x * y) = --x * y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_RMUL = prove
+ (`!x y. --(x * y) = x * --y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_MUL2 = prove
+ (`!x y. --x * --y = x * y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_ADD = prove
+ (`!x y. x - y + y = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_ADD2 = prove
+ (`!x y. y + x - y = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_REFL = prove
+ (`!x. x - x = Cx(&0)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_0 = prove
+ (`!x y. (x - y = Cx(&0)) <=> (x = y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_EQ_0 = prove
+ (`!x. (--x = Cx(&0)) <=> (x = Cx(&0))`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_SUB = prove
+ (`!x y. --(x - y) = y - x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_SUB = prove
+ (`!x y. (x + y) - x = y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_EQ = prove
+ (`!x y. (--x = y) <=> (x = --y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_NEG_MINUS1 = prove
+ (`!x. --x = --Cx(&1) * x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_SUB = prove
+ (`!x y. x - y - x = --y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD2_SUB2 = prove
+ (`!a b c d. (a + b) - (c + d) = a - c + b - d`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_LZERO = prove
+ (`!x. Cx(&0) - x = --x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_RZERO = prove
+ (`!x. x - Cx(&0) = x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_LNEG = prove
+ (`!x y. --x - y = --(x + y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_RNEG = prove
+ (`!x y. x - --y = x + y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_NEG2 = prove
+ (`!x y. --x - --y = y - x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_TRIANGLE = prove
+ (`!a b c. a - b + b - c = a - c`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_SUB_LADD = prove
+ (`!x y z. (x = y - z) <=> (x + z = y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_SUB_RADD = prove
+ (`!x y z. (x - y = z) <=> (x = z + y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_SUB2 = prove
+ (`!x y. x - (x - y) = y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_ADD_SUB2 = prove
+ (`!x y. x - (x + y) = --y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_DIFFSQ = prove
+ (`!x y. (x + y) * (x - y) = x * x - y * y`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_EQ_NEG2 = prove
+ (`!x y. (--x = --y) <=> (x = y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_LDISTRIB = prove
+ (`!x y z. x * (y - z) = x * y - x * z`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_SUB_RDISTRIB = prove
+ (`!x y z. (x - y) * z = x * z - y * z`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_MUL_2 = prove
+ (`!x. &2 * x = x + x`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Homomorphic embedding properties for Cx mapping. *)
+(* ------------------------------------------------------------------------- *)
+
+let CX_INJ = prove
+ (`!x y. (Cx(x) = Cx(y)) <=> (x = y)`,
+ REWRITE_TAC[CX_DEF; COMPLEX_EQ; RE; IM]);;
+
+let CX_NEG = prove
+ (`!x. Cx(--x) = --(Cx(x))`,
+ REWRITE_TAC[CX_DEF; complex_neg; RE; IM; REAL_NEG_0]);;
+
+let CX_INV = prove
+ (`!x. Cx(inv x) = inv(Cx x)`,
+ GEN_TAC THEN
+ REWRITE_TAC[CX_DEF; complex_inv; RE; IM] THEN
+ REWRITE_TAC[real_div; REAL_NEG_0; REAL_MUL_LZERO] THEN
+ REWRITE_TAC[COMPLEX_EQ; REAL_POW_2; REAL_MUL_RZERO; RE; IM] THEN
+ REWRITE_TAC[REAL_ADD_RID; REAL_INV_MUL] THEN
+ ASM_CASES_TAC `x = &0` THEN
+ ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO] THEN
+ REWRITE_TAC[REAL_MUL_ASSOC] THEN
+ GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
+ AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[REAL_MUL_RINV]);;
+
+let CX_ADD = prove
+ (`!x y. Cx(x + y) = Cx(x) + Cx(y)`,
+ REWRITE_TAC[CX_DEF; complex_add; RE; IM; REAL_ADD_LID]);;
+
+let CX_SUB = prove
+ (`!x y. Cx(x - y) = Cx(x) - Cx(y)`,
+ REWRITE_TAC[complex_sub; real_sub; CX_ADD; CX_NEG]);;
+
+let CX_MUL = prove
+ (`!x y. Cx(x * y) = Cx(x) * Cx(y)`,
+ REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
+ REWRITE_TAC[REAL_SUB_RZERO; REAL_ADD_RID]);;
+
+let CX_DIV = prove
+ (`!x y. Cx(x / y) = Cx(x) / Cx(y)`,
+ REWRITE_TAC[complex_div; real_div; CX_MUL; CX_INV]);;
+
+let CX_POW = prove
+ (`!x n. Cx(x pow n) = Cx(x) pow n`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; real_pow; CX_MUL]);;
+
+let CX_ABS = prove
+ (`!x. Cx(abs x) = Cx(norm(Cx(x)))`,
+ REWRITE_TAC[CX_DEF; complex_norm; COMPLEX_EQ; RE; IM] THEN
+ REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN
+ REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
+
+let COMPLEX_NORM_CX = prove
+ (`!x. norm(Cx(x)) = abs(x)`,
+ REWRITE_TAC[GSYM CX_INJ; CX_ABS]);;
+
+(* ------------------------------------------------------------------------- *)
+(* A convenient lemma that we need a few times below. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_ENTIRE = prove
+ (`!x y. (x * y = Cx(&0)) <=> (x = Cx(&0)) \/ (y = Cx(&0))`,
+ REWRITE_TAC[COMPLEX_EQ; complex_mul; RE; IM; CX_DEF; GSYM REAL_SOS_EQ_0] THEN
+ CONV_TAC REAL_RING);;
+
+(* ------------------------------------------------------------------------- *)
+(* Powers. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_POW_ADD = prove
+ (`!x m n. x pow (m + n) = x pow m * x pow n`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[ADD_CLAUSES; complex_pow;
+ COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC]);;
+
+let COMPLEX_POW_POW = prove
+ (`!x m n. (x pow m) pow n = x pow (m * n)`,
+ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; MULT_CLAUSES; COMPLEX_POW_ADD]);;
+
+let COMPLEX_POW_1 = prove
+ (`!x. x pow 1 = x`,
+ REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID]);;
+
+let COMPLEX_POW_2 = prove
+ (`!x. x pow 2 = x * x`,
+ REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1]);;
+
+let COMPLEX_POW_NEG = prove
+ (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; EVEN] THEN
+ ASM_CASES_TAC `EVEN n` THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG]);;
+
+let COMPLEX_POW_ONE = prove
+ (`!n. Cx(&1) pow n = Cx(&1)`,
+ INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID]);;
+
+let COMPLEX_POW_MUL = prove
+ (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`,
+ GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_AC]);;
+
+let COMPLEX_POW_II_2 = prove
+ (`ii pow 2 = --Cx(&1)`,
+ REWRITE_TAC[ii; COMPLEX_POW_2; complex_mul; CX_DEF; RE; IM; complex_neg] THEN
+ CONV_TAC REAL_RAT_REDUCE_CONV);;
+
+let COMPLEX_POW_EQ_0 = prove
+ (`!x n. (x pow n = Cx(&0)) <=> (x = Cx(&0)) /\ ~(n = 0)`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[NOT_SUC; complex_pow; COMPLEX_ENTIRE] THENL
+ [SIMPLE_COMPLEX_ARITH_TAC; CONV_TAC TAUT]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Norms (aka "moduli"). *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_NORM_CX = prove
+ (`!x. norm(Cx x) = abs(x)`,
+ GEN_TAC THEN REWRITE_TAC[complex_norm; CX_DEF; RE; IM] THEN
+ REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN
+ REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);;
+
+let COMPLEX_NORM_POS = prove
+ (`!z. &0 <= norm(z)`,
+ SIMP_TAC[complex_norm; SQRT_POS_LE; REAL_POW_2;
+ REAL_LE_SQUARE; REAL_LE_ADD]);;
+
+let COMPLEX_ABS_NORM = prove
+ (`!z. abs(norm z) = norm z`,
+ REWRITE_TAC[real_abs; COMPLEX_NORM_POS]);;
+
+let COMPLEX_NORM_ZERO = prove
+ (`!z. (norm z = &0) <=> (z = Cx(&0))`,
+ GEN_TAC THEN REWRITE_TAC[complex_norm] THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_0] THEN
+ SIMP_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADD; REAL_POS; SQRT_INJ] THEN
+ REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF] THEN
+ SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH
+ `&0 <= x /\ &0 <= y ==> ((x + y = &0) <=> (x = &0) /\ (y = &0))`] THEN
+ REWRITE_TAC[REAL_ENTIRE]);;
+
+let COMPLEX_NORM_NUM = prove
+ (`norm(Cx(&n)) = &n`,
+ REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);;
+
+let COMPLEX_NORM_0 = prove
+ (`norm(Cx(&0)) = &0`,
+ MESON_TAC[COMPLEX_NORM_ZERO]);;
+
+let COMPLEX_NORM_NZ = prove
+ (`!z. &0 < norm(z) <=> ~(z = Cx(&0))`,
+ MESON_TAC[COMPLEX_NORM_ZERO; COMPLEX_ABS_NORM; REAL_ABS_NZ]);;
+
+let COMPLEX_NORM_NEG = prove
+ (`!z. norm(--z) = norm(z)`,
+ REWRITE_TAC[complex_neg; complex_norm; REAL_POW_2; RE; IM] THEN
+ GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;
+
+let COMPLEX_NORM_MUL = prove
+ (`!w z. norm(w * z) = norm(w) * norm(z)`,
+ REPEAT GEN_TAC THEN
+ REWRITE_TAC[complex_norm; complex_mul; RE; IM] THEN
+ SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN
+ AP_TERM_TAC THEN REAL_ARITH_TAC);;
+
+let COMPLEX_NORM_POW = prove
+ (`!z n. norm(z pow n) = norm(z) pow n`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; real_pow; COMPLEX_NORM_NUM; COMPLEX_NORM_MUL]);;
+
+let COMPLEX_NORM_INV = prove
+ (`!z. norm(inv z) = inv(norm z)`,
+ GEN_TAC THEN REWRITE_TAC[complex_norm; complex_inv; RE; IM] THEN
+ REWRITE_TAC[REAL_POW_2; real_div] THEN
+ REWRITE_TAC[REAL_ARITH `(r * d) * r * d + (--i * d) * --i * d =
+ (r * r + i * i) * d * d:real`] THEN
+ ASM_CASES_TAC `Re z * Re z + Im z * Im z = &0` THENL
+ [ASM_REWRITE_TAC[REAL_INV_0; SQRT_0; REAL_MUL_LZERO]; ALL_TAC] THEN
+ CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN
+ SIMP_TAC[GSYM SQRT_MUL; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LE_ADD;
+ REAL_LE_SQUARE] THEN
+ ONCE_REWRITE_TAC[AC REAL_MUL_AC
+ `a * a * b * b:real = (a * b) * (a * b)`] THEN
+ ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; SQRT_1]);;
+
+let COMPLEX_NORM_DIV = prove
+ (`!w z. norm(w / z) = norm(w) / norm(z)`,
+ REWRITE_TAC[complex_div; real_div; COMPLEX_NORM_INV; COMPLEX_NORM_MUL]);;
+
+let COMPLEX_NORM_TRIANGLE = prove
+ (`!w z. norm(w + z) <= norm(w) + norm(z)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm; complex_add; RE; IM] THEN
+ MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs(x) <= abs(y) ==> x <= y`) THEN
+ SIMP_TAC[SQRT_POS_LE; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE;
+ REAL_LE_SQUARE_ABS; SQRT_POW_2] THEN
+ GEN_REWRITE_TAC RAND_CONV[REAL_ARITH
+ `(a + b) * (a + b) = a * a + b * b + &2 * a * b`] THEN
+ REWRITE_TAC[GSYM REAL_POW_2] THEN
+ SIMP_TAC[SQRT_POW_2; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN
+ REWRITE_TAC[REAL_ARITH
+ `(rw + rz) * (rw + rz) + (iw + iz) * (iw + iz) <=
+ (rw * rw + iw * iw) + (rz * rz + iz * iz) + &2 * other <=>
+ rw * rz + iw * iz <= other`] THEN
+ SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN
+ MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs(x) <= abs(y) ==> x <= y`) THEN
+ SIMP_TAC[SQRT_POS_LE; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE;
+ REAL_LE_SQUARE_ABS; SQRT_POW_2; REAL_LE_MUL] THEN
+ REWRITE_TAC[REAL_ARITH
+ `(rw * rz + iw * iz) * (rw * rz + iw * iz) <=
+ (rw * rw + iw * iw) * (rz * rz + iz * iz) <=>
+ &0 <= (rw * iz - rz * iw) * (rw * iz - rz * iw)`] THEN
+ REWRITE_TAC[REAL_LE_SQUARE]);;
+
+let COMPLEX_NORM_TRIANGLE_SUB = prove
+ (`!w z. norm(w) <= norm(w + z) + norm(z)`,
+ MESON_TAC[COMPLEX_NORM_TRIANGLE; COMPLEX_NORM_NEG; COMPLEX_ADD_ASSOC;
+ COMPLEX_ADD_RINV; COMPLEX_ADD_RID]);;
+
+let COMPLEX_NORM_ABS_NORM = prove
+ (`!w z. abs(norm w - norm z) <= norm(w - z)`,
+ REPEAT GEN_TAC THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `a - b <= x /\ b - a <= x ==> abs(a - b) <= x:real`) THEN
+ MESON_TAC[COMPLEX_NEG_SUB; COMPLEX_NORM_NEG; REAL_LE_SUB_RADD; complex_sub;
+ COMPLEX_NORM_TRIANGLE_SUB]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex conjugate. *)
+(* ------------------------------------------------------------------------- *)
+
+let cnj = new_definition
+ `cnj(z) = complex(Re(z),--(Im(z)))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Conjugation is an automorphism. *)
+(* ------------------------------------------------------------------------- *)
+
+let CNJ_INJ = prove
+ (`!w z. (cnj(w) = cnj(z)) <=> (w = z)`,
+ REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_EQ_NEG2]);;
+
+let CNJ_CNJ = prove
+ (`!z. cnj(cnj z) = z`,
+ REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_NEG_NEG]);;
+
+let CNJ_CX = prove
+ (`!x. cnj(Cx x) = Cx x`,
+ REWRITE_TAC[cnj; COMPLEX_EQ; CX_DEF; REAL_NEG_0; RE; IM]);;
+
+let COMPLEX_NORM_CNJ = prove
+ (`!z. norm(cnj z) = norm(z)`,
+ REWRITE_TAC[complex_norm; cnj; REAL_POW_2] THEN
+ REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; RE; IM; REAL_NEG_NEG]);;
+
+let CNJ_NEG = prove
+ (`!z. cnj(--z) = --(cnj z)`,
+ REWRITE_TAC[cnj; complex_neg; COMPLEX_EQ; RE; IM]);;
+
+let CNJ_INV = prove
+ (`!z. cnj(inv z) = inv(cnj z)`,
+ REWRITE_TAC[cnj; complex_inv; COMPLEX_EQ; RE; IM] THEN
+ REWRITE_TAC[real_div; REAL_NEG_NEG; REAL_POW_2;
+ REAL_MUL_LNEG; REAL_MUL_RNEG]);;
+
+let CNJ_ADD = prove
+ (`!w z. cnj(w + z) = cnj(w) + cnj(z)`,
+ REWRITE_TAC[cnj; complex_add; COMPLEX_EQ; RE; IM] THEN
+ REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);;
+
+let CNJ_SUB = prove
+ (`!w z. cnj(w - z) = cnj(w) - cnj(z)`,
+ REWRITE_TAC[complex_sub; CNJ_ADD; CNJ_NEG]);;
+
+let CNJ_MUL = prove
+ (`!w z. cnj(w * z) = cnj(w) * cnj(z)`,
+ REWRITE_TAC[cnj; complex_mul; COMPLEX_EQ; RE; IM] THEN
+ REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);;
+
+let CNJ_DIV = prove
+ (`!w z. cnj(w / z) = cnj(w) / cnj(z)`,
+ REWRITE_TAC[complex_div; CNJ_MUL; CNJ_INV]);;
+
+let CNJ_POW = prove
+ (`!z n. cnj(z pow n) = cnj(z) pow n`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; CNJ_MUL; CNJ_CX]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Conversion of (complex-type) rational constant to ML rational number. *)
+(* ------------------------------------------------------------------------- *)
+
+let is_complex_const =
+ let cx_tm = `Cx` in
+ fun tm ->
+ is_comb tm &
+ let l,r = dest_comb tm in l = cx_tm & is_ratconst r;;
+
+let dest_complex_const =
+ let cx_tm = `Cx` in
+ fun tm ->
+ let l,r = dest_comb tm in
+ if l = cx_tm then rat_of_term r
+ else failwith "dest_complex_const";;
+
+let mk_complex_const =
+ let cx_tm = `Cx` in
+ fun r ->
+ mk_comb(cx_tm,term_of_rat r);;
+
+(* ------------------------------------------------------------------------- *)
+(* Conversions to perform operations if coefficients are rational constants. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_RAT_MUL_CONV =
+ GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;;
+
+let COMPLEX_RAT_ADD_CONV =
+ GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;;
+
+let COMPLEX_RAT_EQ_CONV =
+ GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;;
+
+let COMPLEX_RAT_POW_CONV =
+ let x_tm = `x:real`
+ and n_tm = `n:num` in
+ let pth = SYM(SPECL [x_tm; n_tm] CX_POW) in
+ fun tm ->
+ let lop,r = dest_comb tm in
+ let op,bod = dest_comb lop in
+ let th1 = INST [rand bod,x_tm; r,n_tm] pth in
+ let tm1,tm2 = dest_comb(concl th1) in
+ if rand tm1 <> tm then failwith "COMPLEX_RAT_POW_CONV" else
+ let tm3,tm4 = dest_comb tm2 in
+ TRANS th1 (AP_TERM tm3 (REAL_RAT_REDUCE_CONV tm4));;
+
+(* ------------------------------------------------------------------------- *)
+(* Instantiate polynomial normalizer. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_POLY_CLAUSES = prove
+ (`(!x y z. x + (y + z) = (x + y) + z) /\
+ (!x y. x + y = y + x) /\
+ (!x. Cx(&0) + x = x) /\
+ (!x y z. x * (y * z) = (x * y) * z) /\
+ (!x y. x * y = y * x) /\
+ (!x. Cx(&1) * x = x) /\
+ (!x. Cx(&0) * x = Cx(&0)) /\
+ (!x y z. x * (y + z) = x * y + x * z) /\
+ (!x. x pow 0 = Cx(&1)) /\
+ (!x n. x pow (SUC n) = x * x pow n)`,
+ REWRITE_TAC[complex_pow] THEN SIMPLE_COMPLEX_ARITH_TAC)
+and COMPLEX_POLY_NEG_CLAUSES = prove
+ (`(!x. --x = Cx(-- &1) * x) /\
+ (!x y. x - y = x + Cx(-- &1) * y)`,
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let COMPLEX_POLY_NEG_CONV,COMPLEX_POLY_ADD_CONV,COMPLEX_POLY_SUB_CONV,
+ COMPLEX_POLY_MUL_CONV,COMPLEX_POLY_POW_CONV,COMPLEX_POLY_CONV =
+ SEMIRING_NORMALIZERS_CONV COMPLEX_POLY_CLAUSES COMPLEX_POLY_NEG_CLAUSES
+ (is_complex_const,
+ COMPLEX_RAT_ADD_CONV,COMPLEX_RAT_MUL_CONV,COMPLEX_RAT_POW_CONV)
+ (<);;
+
+let COMPLEX_RAT_INV_CONV =
+ GEN_REWRITE_CONV I [GSYM CX_INV] THENC RAND_CONV REAL_RAT_INV_CONV;;
+
+let COMPLEX_POLY_CONV =
+ let neg_tm = `(--):complex->complex`
+ and inv_tm = `inv:complex->complex`
+ and add_tm = `(+):complex->complex->complex`
+ and sub_tm = `(-):complex->complex->complex`
+ and mul_tm = `(*):complex->complex->complex`
+ and div_tm = `(/):complex->complex->complex`
+ and pow_tm = `(pow):complex->num->complex`
+ and div_conv = REWR_CONV complex_div in
+ let rec COMPLEX_POLY_CONV tm =
+ if not(is_comb tm) or is_complex_const tm then REFL tm else
+ let lop,r = dest_comb tm in
+ if lop = neg_tm then
+ let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in
+ TRANS th1 (COMPLEX_POLY_NEG_CONV (rand(concl th1)))
+ else if lop = inv_tm then
+ let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in
+ TRANS th1 (TRY_CONV COMPLEX_RAT_INV_CONV (rand(concl th1)))
+ else if not(is_comb lop) then REFL tm else
+ let op,l = dest_comb lop in
+ if op = pow_tm then
+ let th1 = AP_THM (AP_TERM op (COMPLEX_POLY_CONV l)) r in
+ TRANS th1 (TRY_CONV COMPLEX_POLY_POW_CONV (rand(concl th1)))
+ else if op = add_tm or op = mul_tm or op = sub_tm then
+ let th1 = MK_COMB(AP_TERM op (COMPLEX_POLY_CONV l),
+ COMPLEX_POLY_CONV r) in
+ let fn = if op = add_tm then COMPLEX_POLY_ADD_CONV
+ else if op = mul_tm then COMPLEX_POLY_MUL_CONV
+ else COMPLEX_POLY_SUB_CONV in
+ TRANS th1 (fn (rand(concl th1)))
+ else if op = div_tm then
+ let th1 = div_conv tm in
+ TRANS th1 (COMPLEX_POLY_CONV (rand(concl th1)))
+ else REFL tm in
+ COMPLEX_POLY_CONV;;
+
+(* ------------------------------------------------------------------------- *)
+(* Complex number version of usual ring procedure. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_MUL_LINV = prove
+ (`!z. ~(z = Cx(&0)) ==> (inv(z) * z = Cx(&1))`,
+ REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN
+ REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);;
+
+let COMPLEX_MUL_RINV = prove
+ (`!z. ~(z = Cx(&0)) ==> (z * inv(z) = Cx(&1))`,
+ ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[COMPLEX_MUL_LINV]);;
+
+let COMPLEX_RING,complex_ideal_cofactors =
+ let ring_pow_tm = `(pow):complex->num->complex`
+ and COMPLEX_INTEGRAL = prove
+ (`(!x. Cx(&0) * x = Cx(&0)) /\
+ (!x y z. (x + y = x + z) <=> (y = z)) /\
+ (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`,
+ REWRITE_TAC[COMPLEX_ENTIRE; SIMPLE_COMPLEX_ARITH
+ `(w * y + x * z = w * z + x * y) <=>
+ (w - x) * (y - z) = Cx(&0)`] THEN
+ SIMPLE_COMPLEX_ARITH_TAC)
+ and COMPLEX_RABINOWITSCH = prove
+ (`!x y:complex. ~(x = y) <=> ?z. (x - y) * z = Cx(&1)`,
+ REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_SUB_0] THEN
+ MESON_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LZERO;
+ SIMPLE_COMPLEX_ARITH `~(Cx(&1) = Cx(&0))`])
+ and init = ALL_CONV in
+ let pure,ideal =
+ RING_AND_IDEAL_CONV
+ (dest_complex_const,mk_complex_const,COMPLEX_RAT_EQ_CONV,
+ `(--):complex->complex`,`(+):complex->complex->complex`,
+ `(-):complex->complex->complex`,`(inv):complex->complex`,
+ `(*):complex->complex->complex`,`(/):complex->complex->complex`,
+ `(pow):complex->num->complex`,
+ COMPLEX_INTEGRAL,COMPLEX_RABINOWITSCH,COMPLEX_POLY_CONV) in
+ (fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)))),
+ ideal;;
+
+(* ------------------------------------------------------------------------- *)
+(* Most basic properties of inverses. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_INV_0 = prove
+ (`inv(Cx(&0)) = Cx(&0)`,
+ REWRITE_TAC[complex_inv; CX_DEF; RE; IM; real_div; REAL_MUL_LZERO;
+ REAL_NEG_0]);;
+
+let COMPLEX_INV_MUL = prove
+ (`!w z. inv(w * z) = inv(w) * inv(z)`,
+ REPEAT GEN_TAC THEN
+ MAP_EVERY ASM_CASES_TAC [`w = Cx(&0)`; `z = Cx(&0)`] THEN
+ ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN
+ REPEAT(POP_ASSUM MP_TAC) THEN
+ REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN
+ REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);;
+
+let COMPLEX_INV_1 = prove
+ (`inv(Cx(&1)) = Cx(&1)`,
+ REWRITE_TAC[complex_inv; CX_DEF; RE; IM] THEN
+ CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1]);;
+
+let COMPLEX_POW_INV = prove
+ (`!x n. (inv x) pow n = inv(x pow n)`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[complex_pow; COMPLEX_INV_1; COMPLEX_INV_MUL]);;
+
+let COMPLEX_INV_INV = prove
+ (`!x:complex. inv(inv x) = x`,
+ GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN
+ ASM_REWRITE_TAC[COMPLEX_INV_0] THEN
+ POP_ASSUM MP_TAC THEN
+ MAP_EVERY (fun t -> MP_TAC(SPEC t COMPLEX_MUL_RINV))
+ [`x:complex`; `inv(x):complex`] THEN
+ CONV_TAC COMPLEX_RING);;
+
+(* ------------------------------------------------------------------------- *)
+(* And also field procedure. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_FIELD =
+ let prenex_conv =
+ TOP_DEPTH_CONV BETA_CONV THENC
+ PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; complex_div;
+ COMPLEX_INV_INV; COMPLEX_INV_MUL; GSYM REAL_POW_INV] THENC
+ NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC
+ PRENEX_CONV
+ and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV
+ and is_inv =
+ let inv_tm = `inv:complex->complex`
+ and is_div = is_binop `(/):complex->complex->complex` in
+ fun tm -> (is_div tm or (is_comb tm & rator tm = inv_tm)) &
+ not(is_complex_const(rand tm))
+ and lemma_inv = MESON[COMPLEX_MUL_RINV]
+ `!x. x = Cx(&0) \/ x * inv(x) = Cx(&1)`
+ and dcases = MATCH_MP(TAUT `(p \/ q) /\ (r \/ s) ==> (p \/ r) \/ q /\ s`) in
+ let cases_rule th1 th2 = dcases (CONJ th1 th2) in
+ let BASIC_COMPLEX_FIELD tm =
+ let is_freeinv t = is_inv t & free_in t tm in
+ let itms = setify(map rand (find_terms is_freeinv tm)) in
+ let dth = if itms = [] then TRUTH
+ else end_itlist cases_rule (map (C SPEC lemma_inv) itms) in
+ let tm' = mk_imp(concl dth,tm) in
+ let th1 = setup_conv tm' in
+ let ths = map COMPLEX_RING (conjuncts(rand(concl th1))) in
+ let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in
+ MP (EQ_MP (SYM th1) (end_itlist CONJ ths)) dth in
+ fun tm ->
+ let th0 = prenex_conv tm in
+ let tm0 = rand(concl th0) in
+ let avs,bod = strip_forall tm0 in
+ let th1 = setup_conv bod in
+ let ths = map BASIC_COMPLEX_FIELD (conjuncts(rand(concl th1))) in
+ EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));;
+
+(* ------------------------------------------------------------------------- *)
+(* Properties of inverses, divisions are now mostly automatic. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_POW_DIV = prove
+ (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`,
+ REWRITE_TAC[complex_div; COMPLEX_POW_MUL; COMPLEX_POW_INV]);;
+
+let COMPLEX_DIV_REFL = prove
+ (`!x. ~(x = Cx(&0)) ==> (x / x = Cx(&1))`,
+ CONV_TAC COMPLEX_FIELD);;
+
+let COMPLEX_EQ_MUL_LCANCEL = prove
+ (`!x y z. (x * y = x * z) <=> (x = Cx(&0)) \/ (y = z)`,
+ CONV_TAC COMPLEX_FIELD);;
+
+let COMPLEX_EQ_MUL_RCANCEL = prove
+ (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = Cx(&0))`,
+ CONV_TAC COMPLEX_FIELD);;
+
+let COMPLEX_MUL_RINV_UNIQ = prove
+ (`!w z. w * z = Cx(&1) ==> inv w = z`,
+ CONV_TAC COMPLEX_FIELD);;
+
+let COMPLEX_MUL_LINV_UNIQ = prove
+ (`!w z. w * z = Cx(&1) ==> inv z = w`,
+ CONV_TAC COMPLEX_FIELD);;
+
+let COMPLEX_DIV_LMUL = prove
+ (`!w z. ~(z = Cx(&0)) ==> z * w / z = w`,
+ CONV_TAC COMPLEX_FIELD);;
+
+let COMPLEX_DIV_RMUL = prove
+ (`!w z. ~(z = Cx(&0)) ==> w / z * z = w`,
+ CONV_TAC COMPLEX_FIELD);;
--- /dev/null
+(* ========================================================================= *)
+(* Properties of complex polynomials (not canonically represented). *)
+(* ========================================================================= *)
+
+needs "Complex/complexnumbers.ml";;
+
+prioritize_complex();;
+
+parse_as_infix("++",(16,"right"));;
+parse_as_infix("**",(20,"right"));;
+parse_as_infix("##",(20,"right"));;
+parse_as_infix("divides",(14,"right"));;
+parse_as_infix("exp",(22,"right"));;
+
+do_list override_interface
+ ["++",`poly_add:complex list->complex list->complex list`;
+ "**",`poly_mul:complex list->complex list->complex list`;
+ "##",`poly_cmul:complex->complex list->complex list`;
+ "neg",`poly_neg:complex list->complex list`;
+ "divides",`poly_divides:complex list->complex list->bool`;
+ "exp",`poly_exp:complex list -> num -> complex list`;
+ "diff",`poly_diff:complex list->complex list`];;
+
+let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let poly = new_recursive_definition list_RECURSION
+ `(poly [] x = Cx(&0)) /\
+ (poly (CONS h t) x = h + x * poly t x)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetic operations on polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let poly_add = new_recursive_definition list_RECURSION
+ `([] ++ l2 = l2) /\
+ ((CONS h t) ++ l2 =
+ (if l2 = [] then CONS h t
+ else CONS (h + HD l2) (t ++ TL l2)))`;;
+
+let poly_cmul = new_recursive_definition list_RECURSION
+ `(c ## [] = []) /\
+ (c ## (CONS h t) = CONS (c * h) (c ## t))`;;
+
+let poly_neg = new_definition
+ `neg = (##) (--(Cx(&1)))`;;
+
+let poly_mul = new_recursive_definition list_RECURSION
+ `([] ** l2 = []) /\
+ ((CONS h t) ** l2 =
+ if t = [] then h ## l2
+ else (h ## l2) ++ CONS (Cx(&0)) (t ** l2))`;;
+
+let poly_exp = new_recursive_definition num_RECURSION
+ `(p exp 0 = [Cx(&1)]) /\
+ (p exp (SUC n) = p ** p exp n)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Useful clausifications. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ADD_CLAUSES = prove
+ (`([] ++ p2 = p2) /\
+ (p1 ++ [] = p1) /\
+ ((CONS h1 t1) ++ (CONS h2 t2) = CONS (h1 + h2) (t1 ++ t2))`,
+ REWRITE_TAC[poly_add; NOT_CONS_NIL; HD; TL] THEN
+ SPEC_TAC(`p1:complex list`,`p1:complex list`) THEN
+ LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_add]);;
+
+let POLY_CMUL_CLAUSES = prove
+ (`(c ## [] = []) /\
+ (c ## (CONS h t) = CONS (c * h) (c ## t))`,
+ REWRITE_TAC[poly_cmul]);;
+
+let POLY_NEG_CLAUSES = prove
+ (`(neg [] = []) /\
+ (neg (CONS h t) = CONS (--h) (neg t))`,
+ REWRITE_TAC[poly_neg; POLY_CMUL_CLAUSES;
+ COMPLEX_MUL_LNEG; COMPLEX_MUL_LID]);;
+
+let POLY_MUL_CLAUSES = prove
+ (`([] ** p2 = []) /\
+ ([h1] ** p2 = h1 ## p2) /\
+ ((CONS h1 (CONS k1 t1)) ** p2 =
+ h1 ## p2 ++ CONS (Cx(&0)) (CONS k1 t1 ** p2))`,
+ REWRITE_TAC[poly_mul; NOT_CONS_NIL]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Various natural consequences of syntactic definitions. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ADD = prove
+ (`!p1 p2 x. poly (p1 ++ p2) x = poly p1 x + poly p2 x`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[poly_add; poly; COMPLEX_ADD_LID] THEN
+ LIST_INDUCT_TAC THEN
+ ASM_REWRITE_TAC[NOT_CONS_NIL; HD; TL; poly; COMPLEX_ADD_RID] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_CMUL = prove
+ (`!p c x. poly (c ## p) x = c * poly p x`,
+ LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly; poly_cmul] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_NEG = prove
+ (`!p x. poly (neg p) x = --(poly p x)`,
+ REWRITE_TAC[poly_neg; POLY_CMUL] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_MUL = prove
+ (`!x p1 p2. poly (p1 ** p2) x = poly p1 x * poly p2 x`,
+ GEN_TAC THEN LIST_INDUCT_TAC THEN
+ REWRITE_TAC[poly_mul; poly; COMPLEX_MUL_LZERO; POLY_CMUL; POLY_ADD] THEN
+ SPEC_TAC(`h:complex`,`h:complex`) THEN
+ SPEC_TAC(`t:complex list`,`t:complex list`) THEN
+ LIST_INDUCT_TAC THEN
+ REWRITE_TAC[poly_mul; POLY_CMUL; POLY_ADD; poly; POLY_CMUL;
+ COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; NOT_CONS_NIL] THEN
+ ASM_REWRITE_TAC[POLY_ADD; POLY_CMUL; poly] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_EXP = prove
+ (`!p n x. poly (p exp n) x = (poly p x) pow n`,
+ GEN_TAC THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[poly_exp; complex_pow; POLY_MUL] THEN
+ REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Lemmas. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ADD_RZERO = prove
+ (`!p. poly (p ++ []) = poly p`,
+ REWRITE_TAC[FUN_EQ_THM; POLY_ADD; poly; COMPLEX_ADD_RID]);;
+
+let POLY_MUL_ASSOC = prove
+ (`!p q r. poly (p ** (q ** r)) = poly ((p ** q) ** r)`,
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]);;
+
+let POLY_EXP_ADD = prove
+ (`!d n p. poly(p exp (n + d)) = poly(p exp n ** p exp d)`,
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN
+ INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_MUL; ADD_CLAUSES; poly_exp; poly] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Key property that f(a) = 0 ==> (x - a) divides p(x). Very delicate! *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_LINEAR_REM = prove
+ (`!t h. ?q r. CONS h t = [r] ++ [--a; Cx(&1)] ** q`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[] THENL
+ [GEN_TAC THEN EXISTS_TAC `[]:complex list` THEN
+ EXISTS_TAC `h:complex` THEN
+ REWRITE_TAC[poly_add; poly_mul; poly_cmul; NOT_CONS_NIL] THEN
+ REWRITE_TAC[HD; TL; COMPLEX_ADD_RID];
+ X_GEN_TAC `k:complex` THEN
+ POP_ASSUM(STRIP_ASSUME_TAC o SPEC `h:complex`) THEN
+ EXISTS_TAC `CONS (r:complex) q` THEN EXISTS_TAC `r * a + k` THEN
+ ASM_REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN
+ REWRITE_TAC[CONS_11] THEN CONJ_TAC THENL
+ [SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN
+ SPEC_TAC(`q:complex list`,`q:complex list`) THEN
+ LIST_INDUCT_TAC THEN
+ REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN
+ REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_LID] THEN
+ REWRITE_TAC[COMPLEX_ADD_AC]]);;
+
+let POLY_LINEAR_DIVIDES = prove
+ (`!a p. (poly p a = Cx(&0)) <=> (p = []) \/ ?q. p = [--a; Cx(&1)] ** q`,
+ GEN_TAC THEN LIST_INDUCT_TAC THENL
+ [REWRITE_TAC[poly]; ALL_TAC] THEN
+ EQ_TAC THEN STRIP_TAC THENL
+ [DISJ2_TAC THEN STRIP_ASSUME_TAC(SPEC_ALL POLY_LINEAR_REM) THEN
+ EXISTS_TAC `q:complex list` THEN ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `r = Cx(&0)` SUBST_ALL_TAC THENL
+ [UNDISCH_TAC `poly (CONS h t) a = Cx(&0)` THEN
+ ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_ADD; POLY_MUL] THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID;
+ COMPLEX_MUL_RID] THEN
+ REWRITE_TAC[COMPLEX_ADD_LINV] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ REWRITE_TAC[poly_mul] THEN REWRITE_TAC[NOT_CONS_NIL] THEN
+ SPEC_TAC(`q:complex list`,`q:complex list`) THEN LIST_INDUCT_TAC THENL
+ [REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL;
+ HD; TL; COMPLEX_ADD_LID];
+ REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL;
+ HD; TL; COMPLEX_ADD_LID]]];
+ ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly];
+ ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly] THEN
+ REWRITE_TAC[POLY_MUL] THEN REWRITE_TAC[poly] THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN
+ REWRITE_TAC[COMPLEX_ADD_LINV] THEN SIMPLE_COMPLEX_ARITH_TAC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Thanks to the finesse of the above, we can use length rather than degree. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_LENGTH_MUL = prove
+ (`!q. LENGTH([--a; Cx(&1)] ** q) = SUC(LENGTH q)`,
+ let lemma = prove
+ (`!p h k a. LENGTH (k ## p ++ CONS h (a ## p)) = SUC(LENGTH p)`,
+ LIST_INDUCT_TAC THEN
+ ASM_REWRITE_TAC[poly_cmul; POLY_ADD_CLAUSES; LENGTH]) in
+ REWRITE_TAC[poly_mul; NOT_CONS_NIL; lemma]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Thus a nontrivial polynomial of degree n has no more than n roots. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ROOTS_INDEX_LEMMA = prove
+ (`!n. !p. ~(poly p = poly []) /\ (LENGTH p = n)
+ ==> ?i. !x. (poly p x = Cx(&0)) ==> ?m. m <= n /\ (x = i m)`,
+ INDUCT_TAC THENL
+ [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[];
+ REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a. poly p a = Cx(&0)` THENL
+ [UNDISCH_TAC `?a. poly p a = Cx(&0)` THEN
+ DISCH_THEN(CHOOSE_THEN MP_TAC) THEN
+ GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN
+ DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN
+ FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
+ UNDISCH_TAC `~(poly ([-- a; Cx(&1)] ** q) = poly [])` THEN
+ POP_ASSUM MP_TAC THEN REWRITE_TAC[POLY_LENGTH_MUL; SUC_INJ] THEN
+ DISCH_TAC THEN ASM_CASES_TAC `poly q = poly []` THENL
+ [ASM_REWRITE_TAC[POLY_MUL; poly; COMPLEX_MUL_RZERO; FUN_EQ_THM];
+ DISCH_THEN(K ALL_TAC)] THEN
+ DISCH_THEN(MP_TAC o SPEC `q:complex list`) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_TAC `i:num->complex`) THEN
+ EXISTS_TAC `\m. if m = SUC n then a:complex else i m` THEN
+ REWRITE_TAC[POLY_MUL; LE; COMPLEX_ENTIRE] THEN
+ X_GEN_TAC `x:complex` THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
+ [DISCH_THEN(fun th -> EXISTS_TAC `SUC n` THEN MP_TAC th) THEN
+ REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN
+ EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+ UNDISCH_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC];
+ UNDISCH_TAC `~(?a. poly p a = Cx(&0))` THEN
+ REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);;
+
+let POLY_ROOTS_INDEX_LENGTH = prove
+ (`!p. ~(poly p = poly [])
+ ==> ?i. !x. (poly p(x) = Cx(&0)) ==> ?n. n <= LENGTH p /\ (x = i n)`,
+ MESON_TAC[POLY_ROOTS_INDEX_LEMMA]);;
+
+let POLY_ROOTS_FINITE_LEMMA = prove
+ (`!p. ~(poly p = poly [])
+ ==> ?N i. !x. (poly p(x) = Cx(&0)) ==> ?n:num. n < N /\ (x = i n)`,
+ MESON_TAC[POLY_ROOTS_INDEX_LENGTH; LT_SUC_LE]);;
+
+let FINITE_LEMMA = prove
+ (`!i N P. (!x. P x ==> ?n:num. n < N /\ (x = i n))
+ ==> ?a. !x. P x ==> norm(x) < a`,
+ GEN_TAC THEN ONCE_REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN INDUCT_TAC THENL
+ [REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN
+ X_GEN_TAC `P:complex->bool` THEN
+ POP_ASSUM(MP_TAC o SPEC `\z. P z /\ ~(z = (i:num->complex) N)`) THEN
+ DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN
+ EXISTS_TAC `abs(a) + norm(i(N:num)) + &1` THEN
+ POP_ASSUM MP_TAC THEN REWRITE_TAC[LT] THEN
+ SUBGOAL_THEN `(!x. norm(x) < abs(a) + norm(x) + &1) /\
+ (!x y. norm(x) < a ==> norm(x) < abs(a) + norm(y) + &1)`
+ (fun th -> MP_TAC th THEN MESON_TAC[]) THEN
+ CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
+ REPEAT GEN_TAC THEN MP_TAC(SPEC `y:complex` COMPLEX_NORM_POS) THEN
+ REAL_ARITH_TAC);;
+
+let POLY_ROOTS_FINITE = prove
+ (`!p. ~(poly p = poly []) <=>
+ ?N i. !x. (poly p(x) = Cx(&0)) ==> ?n:num. n < N /\ (x = i n)`,
+ GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE_LEMMA] THEN
+ REWRITE_TAC[FUN_EQ_THM; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM; poly] THEN
+ MP_TAC(GENL [`i:num->complex`; `N:num`]
+ (SPECL [`i:num->complex`; `N:num`; `\x. poly p x = Cx(&0)`]
+ FINITE_LEMMA)) THEN
+ REWRITE_TAC[] THEN MESON_TAC[REAL_ARITH `~(abs(x) < x)`; COMPLEX_NORM_CX]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence get entirety and cancellation for polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ENTIRE_LEMMA = prove
+ (`!p q. ~(poly p = poly []) /\ ~(poly q = poly [])
+ ==> ~(poly (p ** q) = poly [])`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN
+ DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `N2:num` (X_CHOOSE_TAC `i2:num->complex`)) THEN
+ DISCH_THEN(X_CHOOSE_THEN `N1:num` (X_CHOOSE_TAC `i1:num->complex`)) THEN
+ EXISTS_TAC `N1 + N2:num` THEN
+ EXISTS_TAC `\n:num. if n < N1 then i1(n):complex else i2(n - N1)` THEN
+ X_GEN_TAC `x:complex` THEN REWRITE_TAC[COMPLEX_ENTIRE; POLY_MUL] THEN
+ DISCH_THEN(DISJ_CASES_THEN (ANTE_RES_THEN (X_CHOOSE_TAC `n:num`))) THENL
+ [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN
+ FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN ARITH_TAC;
+ EXISTS_TAC `N1 + n:num` THEN ASM_REWRITE_TAC[LT_ADD_LCANCEL] THEN
+ REWRITE_TAC[ARITH_RULE `~(m + n < m:num)`] THEN
+ AP_TERM_TAC THEN ARITH_TAC]);;
+
+let POLY_ENTIRE = prove
+ (`!p q. (poly (p ** q) = poly []) <=>
+ (poly p = poly []) \/ (poly q = poly [])`,
+ REPEAT GEN_TAC THEN EQ_TAC THENL
+ [MESON_TAC[POLY_ENTIRE_LEMMA];
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN
+ STRIP_TAC THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO; poly]]);;
+
+let POLY_MUL_LCANCEL = prove
+ (`!p q r. (poly (p ** q) = poly (p ** r)) <=>
+ (poly p = poly []) \/ (poly q = poly r)`,
+ let lemma1 = prove
+ (`!p q. (poly (p ++ neg q) = poly []) <=> (poly p = poly q)`,
+ REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; poly] THEN
+ REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(p + --q = Cx(&0)) <=> (p = q)`]) in
+ let lemma2 = prove
+ (`!p q r. poly (p ** q ++ neg(p ** r)) = poly (p ** (q ++ neg(r)))`,
+ REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; POLY_MUL] THEN
+ SIMPLE_COMPLEX_ARITH_TAC) in
+ ONCE_REWRITE_TAC[GSYM lemma1] THEN
+ REWRITE_TAC[lemma2; POLY_ENTIRE] THEN
+ REWRITE_TAC[lemma1]);;
+
+let POLY_EXP_EQ_0 = prove
+ (`!p n. (poly (p exp n) = poly []) <=> (poly p = poly []) /\ ~(n = 0)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN
+ REWRITE_TAC[LEFT_AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN
+ SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
+ REWRITE_TAC[poly_exp; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID;
+ CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_SUC] THEN
+ ASM_REWRITE_TAC[POLY_MUL; poly; COMPLEX_ENTIRE] THEN
+ CONV_TAC TAUT);;
+
+let POLY_PRIME_EQ_0 = prove
+ (`!a. ~(poly [a ; Cx(&1)] = poly [])`,
+ GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN
+ DISCH_THEN(MP_TAC o SPEC `Cx(&1) - a`) THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_EXP_PRIME_EQ_0 = prove
+ (`!a n. ~(poly ([a ; Cx(&1)] exp n) = poly [])`,
+ MESON_TAC[POLY_EXP_EQ_0; POLY_PRIME_EQ_0]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Can also prove a more "constructive" notion of polynomial being trivial. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ZERO_LEMMA = prove
+ (`!h t. (poly (CONS h t) = poly []) ==> (h = Cx(&0)) /\ (poly t = poly [])`,
+ let lemma = REWRITE_RULE[FUN_EQ_THM; poly] POLY_ROOTS_FINITE in
+ REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN
+ ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL
+ [REWRITE_TAC[COMPLEX_ADD_LID];
+ DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN
+ POP_ASSUM MP_TAC THEN SIMPLE_COMPLEX_ARITH_TAC] THEN
+ CONV_TAC CONTRAPOS_CONV THEN
+ DISCH_THEN(MP_TAC o REWRITE_RULE[lemma]) THEN
+ DISCH_THEN(X_CHOOSE_THEN `N:num` (X_CHOOSE_TAC `i:num->complex`)) THEN
+ MP_TAC(SPECL
+ [`i:num->complex`; `N:num`; `\x. poly t x = Cx(&0)`] FINITE_LEMMA) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN
+ DISCH_THEN(MP_TAC o SPEC `Cx(abs(a) + &1)`) THEN
+ REWRITE_TAC[COMPLEX_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THENL
+ [REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC;
+ DISCH_THEN(MP_TAC o MATCH_MP
+ (ASSUME `!x. (poly t x = Cx(&0)) ==> norm(x) < a`)) THEN
+ REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]);;
+
+let POLY_ZERO = prove
+ (`!p. (poly p = poly []) <=> ALL (\c. c = Cx(&0)) p`,
+ LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN EQ_TAC THENL
+ [DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN ASM_REWRITE_TAC[];
+ POP_ASSUM(SUBST1_TAC o SYM) THEN STRIP_TAC THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Basics of divisibility. *)
+(* ------------------------------------------------------------------------- *)
+
+let divides = new_definition
+ `p1 divides p2 <=> ?q. poly p2 = poly (p1 ** q)`;;
+
+let POLY_PRIMES = prove
+ (`!a p q. [a; Cx(&1)] divides (p ** q) <=>
+ [a; Cx(&1)] divides p \/ [a; Cx(&1)] divides q`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides; POLY_MUL; FUN_EQ_THM; poly] THEN
+ REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN
+ EQ_TAC THENL
+ [DISCH_THEN(X_CHOOSE_THEN `r:complex list` (MP_TAC o SPEC `--a`)) THEN
+ REWRITE_TAC[COMPLEX_ENTIRE; GSYM complex_sub;
+ COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO] THEN
+ DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN
+ (POP_ASSUM(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN
+ REWRITE_TAC[COMPLEX_NEG_NEG] THEN
+ DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC
+ (X_CHOOSE_THEN `s:complex list` SUBST_ALL_TAC)) THENL
+ [EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO];
+ EXISTS_TAC `s:complex list` THEN GEN_TAC THEN
+ REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);
+ DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_TAC `s:complex list`)) THEN
+ ASM_REWRITE_TAC[] THENL
+ [EXISTS_TAC `s ** q`; EXISTS_TAC `p ** s`] THEN
+ GEN_TAC THEN REWRITE_TAC[POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC]);;
+
+let POLY_DIVIDES_REFL = prove
+ (`!p. p divides p`,
+ GEN_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[Cx(&1)]` THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_DIVIDES_TRANS = prove
+ (`!p q r. p divides q /\ q divides r ==> p divides r`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN
+ EXISTS_TAC `t ** s` THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]);;
+
+let POLY_DIVIDES_EXP = prove
+ (`!p m n. m <= n ==> (p exp m) divides (p exp n)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN
+ DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN
+ SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN
+ REWRITE_TAC[ADD_CLAUSES; POLY_DIVIDES_REFL] THEN
+ MATCH_MP_TAC POLY_DIVIDES_TRANS THEN
+ EXISTS_TAC `p exp (m + d)` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[divides] THEN EXISTS_TAC `p:complex list` THEN
+ REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_EXP_DIVIDES = prove
+ (`!p q m n. (p exp n) divides q /\ m <= n ==> (p exp m) divides q`,
+ MESON_TAC[POLY_DIVIDES_TRANS; POLY_DIVIDES_EXP]);;
+
+let POLY_DIVIDES_ADD = prove
+ (`!p q r. p divides q /\ p divides r ==> p divides (q ++ r)`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN
+ EXISTS_TAC `t ++ s` THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_DIVIDES_SUB = prove
+ (`!p q r. p divides q /\ p divides (q ++ r) ==> p divides r`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN
+ EXISTS_TAC `s ++ neg(t)` THEN
+ POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL; POLY_NEG] THEN
+ DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
+ REWRITE_TAC[COMPLEX_ADD_LDISTRIB; COMPLEX_MUL_RNEG] THEN
+ ASM_REWRITE_TAC[] THEN SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_DIVIDES_SUB2 = prove
+ (`!p q r. p divides r /\ p divides (q ++ r) ==> p divides q`,
+ REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DIVIDES_SUB THEN
+ EXISTS_TAC `r:complex list` THEN ASM_REWRITE_TAC[] THEN
+ UNDISCH_TAC `p divides (q ++ r)` THEN
+ REWRITE_TAC[divides; POLY_ADD; FUN_EQ_THM; POLY_MUL] THEN
+ DISCH_THEN(X_CHOOSE_TAC `s:complex list`) THEN
+ EXISTS_TAC `s:complex list` THEN
+ X_GEN_TAC `x:complex` THEN POP_ASSUM(MP_TAC o SPEC `x:complex`) THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_DIVIDES_ZERO = prove
+ (`!p q. (poly p = poly []) ==> q divides p`,
+ REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[divides] THEN
+ EXISTS_TAC `[]:complex list` THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]);;
+
+(* ------------------------------------------------------------------------- *)
+(* At last, we can consider the order of a root. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ORDER_EXISTS = prove
+ (`!a d. !p. (LENGTH p = d) /\ ~(poly p = poly [])
+ ==> ?n. ([--a; Cx(&1)] exp n) divides p /\
+ ~(([--a; Cx(&1)] exp (SUC n)) divides p)`,
+ GEN_TAC THEN
+ (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION)
+ `(!p q. mulexp 0 p q = q) /\
+ (!p q n. mulexp (SUC n) p q = p ** (mulexp n p q))` THEN
+ SUBGOAL_THEN
+ `!d. !p. (LENGTH p = d) /\ ~(poly p = poly [])
+ ==> ?n q. (p = mulexp (n:num) [--a; Cx(&1)] q) /\
+ ~(poly q a = Cx(&0))`
+ MP_TAC THENL
+ [INDUCT_TAC THENL
+ [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; ALL_TAC] THEN
+ X_GEN_TAC `p:complex list` THEN
+ ASM_CASES_TAC `poly p a = Cx(&0)` THENL
+ [STRIP_TAC THEN UNDISCH_TAC `poly p a = Cx(&0)` THEN
+ DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN
+ DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN
+ UNDISCH_TAC
+ `!p. (LENGTH p = d) /\ ~(poly p = poly [])
+ ==> ?n q. (p = mulexp (n:num) [--a; Cx(&1)] q) /\
+ ~(poly q a = Cx(&0))` THEN
+ DISCH_THEN(MP_TAC o SPEC `q:complex list`) THEN
+ RULE_ASSUM_TAC(REWRITE_RULE[POLY_LENGTH_MUL; POLY_ENTIRE;
+ DE_MORGAN_THM; SUC_INJ]) THEN
+ ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_THEN `n:num`
+ (X_CHOOSE_THEN `s:complex list` STRIP_ASSUME_TAC)) THEN
+ EXISTS_TAC `SUC n` THEN EXISTS_TAC `s:complex list` THEN
+ ASM_REWRITE_TAC[];
+ STRIP_TAC THEN EXISTS_TAC `0` THEN EXISTS_TAC `p:complex list` THEN
+ ASM_REWRITE_TAC[]];
+ DISCH_TAC THEN REPEAT GEN_TAC THEN
+ DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `n:num`
+ (X_CHOOSE_THEN `s:complex list` STRIP_ASSUME_TAC)) THEN
+ EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[divides] THEN CONJ_TAC THENL
+ [EXISTS_TAC `s:complex list` THEN
+ SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL; poly] THEN
+ SIMPLE_COMPLEX_ARITH_TAC;
+ DISCH_THEN(X_CHOOSE_THEN `r:complex list` MP_TAC) THEN
+ SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
+ ASM_REWRITE_TAC[] THENL
+ [UNDISCH_TAC `~(poly s a = Cx(&0))` THEN CONV_TAC CONTRAPOS_CONV THEN
+ REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
+ REWRITE_TAC[poly; poly_exp; POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN
+ ONCE_REWRITE_TAC[poly_exp] THEN
+ REWRITE_TAC[GSYM POLY_MUL_ASSOC; POLY_MUL_LCANCEL] THEN
+ REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL
+ [REWRITE_TAC[FUN_EQ_THM] THEN
+ DISCH_THEN(MP_TAC o SPEC `a + Cx(&1)`) THEN
+ REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]]]);;
+
+let POLY_ORDER = prove
+ (`!p a. ~(poly p = poly [])
+ ==> ?!n. ([--a; Cx(&1)] exp n) divides p /\
+ ~(([--a; Cx(&1)] exp (SUC n)) divides p)`,
+ MESON_TAC[POLY_ORDER_EXISTS; POLY_EXP_DIVIDES; LE_SUC_LT; LT_CASES]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Definition of order. *)
+(* ------------------------------------------------------------------------- *)
+
+let order = new_definition
+ `order a p = @n. ([--a; Cx(&1)] exp n) divides p /\
+ ~(([--a; Cx(&1)] exp (SUC n)) divides p)`;;
+
+let ORDER = prove
+ (`!p a n. ([--a; Cx(&1)] exp n) divides p /\
+ ~(([--a; Cx(&1)] exp (SUC n)) divides p) <=>
+ (n = order a p) /\
+ ~(poly p = poly [])`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[order] THEN
+ EQ_TAC THEN STRIP_TAC THENL
+ [SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL
+ [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN
+ CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `[]:complex list` THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO];
+ ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN
+ MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[]];
+ ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV] THEN
+ ASM_MESON_TAC[POLY_ORDER]);;
+
+let ORDER_THM = prove
+ (`!p a. ~(poly p = poly [])
+ ==> ([--a; Cx(&1)] exp (order a p)) divides p /\
+ ~(([--a; Cx(&1)] exp (SUC(order a p))) divides p)`,
+ MESON_TAC[ORDER]);;
+
+let ORDER_UNIQUE = prove
+ (`!p a n. ~(poly p = poly []) /\
+ ([--a; Cx(&1)] exp n) divides p /\
+ ~(([--a; Cx(&1)] exp (SUC n)) divides p)
+ ==> (n = order a p)`,
+ MESON_TAC[ORDER]);;
+
+let ORDER_POLY = prove
+ (`!p q a. (poly p = poly q) ==> (order a p = order a q)`,
+ REPEAT STRIP_TAC THEN
+ ASM_REWRITE_TAC[order; divides; FUN_EQ_THM; POLY_MUL]);;
+
+let ORDER_ROOT = prove
+ (`!p a. (poly p a = Cx(&0)) <=> (poly p = poly []) \/ ~(order a p = 0)`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN
+ ASM_REWRITE_TAC[poly] THEN EQ_TAC THENL
+ [DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN
+ ASM_CASES_TAC `p:complex list = []` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN DISCH_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN
+ ASM_REWRITE_TAC[poly_exp; DE_MORGAN_THM] THEN DISJ2_TAC THEN
+ REWRITE_TAC[divides] THEN EXISTS_TAC `q:complex list` THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ DISCH_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN
+ UNDISCH_TAC `~(order a p = 0)` THEN
+ SPEC_TAC(`order a p`,`n:num`) THEN
+ INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; NOT_SUC] THEN
+ DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:complex list` SUBST1_TAC) THEN
+ REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);;
+
+let ORDER_DIVIDES = prove
+ (`!p a n. ([--a; Cx(&1)] exp n) divides p <=>
+ (poly p = poly []) \/ n <= order a p`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN
+ ASM_REWRITE_TAC[] THENL
+ [ASM_REWRITE_TAC[divides] THEN EXISTS_TAC `[]:complex list` THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO];
+ ASM_MESON_TAC[ORDER_THM; POLY_EXP_DIVIDES; NOT_LE; LE_SUC_LT]]);;
+
+let ORDER_DECOMP = prove
+ (`!p a. ~(poly p = poly [])
+ ==> ?q. (poly p = poly (([--a; Cx(&1)] exp (order a p)) ** q)) /\
+ ~([--a; Cx(&1)] divides q)`,
+ REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_THM) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o SPEC `a:complex`) THEN
+ DISCH_THEN(X_CHOOSE_TAC `q:complex list` o REWRITE_RULE[divides]) THEN
+ EXISTS_TAC `q:complex list` THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_TAC `r: complex list` o REWRITE_RULE[divides]) THEN
+ UNDISCH_TAC `~([-- a; Cx(&1)] exp SUC (order a p) divides p)` THEN
+ ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN
+ EXISTS_TAC `r:complex list` THEN
+ ASM_REWRITE_TAC[POLY_MUL; FUN_EQ_THM; poly_exp] THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Important composition properties of orders. *)
+(* ------------------------------------------------------------------------- *)
+
+let ORDER_MUL = prove
+ (`!a p q. ~(poly (p ** q) = poly []) ==>
+ (order a (p ** q) = order a p + order a q)`,
+ REPEAT GEN_TAC THEN
+ DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
+ REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN
+ SUBGOAL_THEN `(order a p + order a q = order a (p ** q)) /\
+ ~(poly (p ** q) = poly [])`
+ MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
+ REWRITE_TAC[GSYM ORDER] THEN CONJ_TAC THENL
+ [MP_TAC(CONJUNCT1 (SPEC `a:complex`
+ (MATCH_MP ORDER_THM (ASSUME `~(poly p = poly [])`)))) THEN
+ DISCH_THEN(X_CHOOSE_TAC `r: complex list` o REWRITE_RULE[divides]) THEN
+ MP_TAC(CONJUNCT1 (SPEC `a:complex`
+ (MATCH_MP ORDER_THM (ASSUME `~(poly q = poly [])`)))) THEN
+ DISCH_THEN(X_CHOOSE_TAC `s: complex list` o REWRITE_RULE[divides]) THEN
+ REWRITE_TAC[divides; FUN_EQ_THM] THEN EXISTS_TAC `s ** r` THEN
+ ASM_REWRITE_TAC[POLY_MUL; POLY_EXP_ADD] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ X_CHOOSE_THEN `r: complex list` STRIP_ASSUME_TAC
+ (SPEC `a:complex` (MATCH_MP ORDER_DECOMP
+ (ASSUME `~(poly p = poly [])`))) THEN
+ X_CHOOSE_THEN `s: complex list` STRIP_ASSUME_TAC
+ (SPEC `a:complex` (MATCH_MP ORDER_DECOMP
+ (ASSUME `~(poly q = poly [])`))) THEN
+ ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_EXP_ADD; POLY_MUL; poly_exp] THEN
+ DISCH_THEN(X_CHOOSE_THEN `t:complex list` STRIP_ASSUME_TAC) THEN
+ SUBGOAL_THEN `[--a; Cx(&1)] divides (r ** s)` MP_TAC THENL
+ [ALL_TAC; ASM_REWRITE_TAC[POLY_PRIMES]] THEN
+ REWRITE_TAC[divides] THEN EXISTS_TAC `t:complex list` THEN
+ SUBGOAL_THEN `poly ([-- a; Cx(&1)] exp (order a p) ** r ** s) =
+ poly ([-- a; Cx(&1)] exp (order a p) **
+ ([-- a; Cx(&1)] ** t))`
+ MP_TAC THENL
+ [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN
+ SUBGOAL_THEN `poly ([-- a; Cx(&1)] exp (order a q) **
+ [-- a; Cx(&1)] exp (order a p) ** r ** s) =
+ poly ([-- a; Cx(&1)] exp (order a q) **
+ [-- a; Cx(&1)] exp (order a p) **
+ [-- a; Cx(&1)] ** t)`
+ MP_TAC THENL
+ [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN
+ FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
+ REWRITE_TAC[COMPLEX_MUL_AC]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Normalization of a polynomial. *)
+(* ------------------------------------------------------------------------- *)
+
+let normalize = new_recursive_definition list_RECURSION
+ `(normalize [] = []) /\
+ (normalize (CONS h t) =
+ if normalize t = [] then if h = Cx(&0) then [] else [h]
+ else CONS h (normalize t))`;;
+
+let POLY_NORMALIZE = prove
+ (`!p. poly (normalize p) = poly p`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN
+ ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN
+ UNDISCH_TAC `poly (normalize t) = poly t` THEN
+ DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN
+ REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID]);;
+
+let LENGTH_NORMALIZE_LE = prove
+ (`!p. LENGTH(normalize p) <= LENGTH p`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; normalize; LE_REFL] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; LE_SUC] THEN
+ COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* The degree of a polynomial. *)
+(* ------------------------------------------------------------------------- *)
+
+let degree = new_definition
+ `degree p = PRE(LENGTH(normalize p))`;;
+
+let DEGREE_ZERO = prove
+ (`!p. (poly p = poly []) ==> (degree p = 0)`,
+ REPEAT STRIP_TAC THEN REWRITE_TAC[degree] THEN
+ SUBGOAL_THEN `normalize p = []` SUBST1_TAC THENL
+ [POP_ASSUM MP_TAC THEN SPEC_TAC(`p:complex list`,`p:complex list`) THEN
+ REWRITE_TAC[POLY_ZERO] THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; ALL] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `normalize t = []` (fun th -> REWRITE_TAC[th]) THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
+ REWRITE_TAC[LENGTH; PRE]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Show that the degree is welldefined. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_CONS_EQ = prove
+ (`(poly (CONS h1 t1) = poly (CONS h2 t2)) <=>
+ (h1 = h2) /\ (poly t1 = poly t2)`,
+ REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[poly]] THEN
+ ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(a = b) <=> (a + --b = Cx(&0))`] THEN
+ REWRITE_TAC[GSYM POLY_NEG; GSYM POLY_ADD] THEN DISCH_TAC THEN
+ SUBGOAL_THEN `poly (CONS h1 t1 ++ neg(CONS h2 t2)) = poly []` MP_TAC THENL
+ [ASM_REWRITE_TAC[poly; FUN_EQ_THM]; ALL_TAC] THEN
+ REWRITE_TAC[poly_neg; poly_cmul; poly_add; NOT_CONS_NIL; HD; TL] THEN
+ DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN
+ SIMP_TAC[poly; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID]);;
+
+let POLY_NORMALIZE_ZERO = prove
+ (`!p. (poly p = poly []) <=> (normalize p = [])`,
+ REWRITE_TAC[POLY_ZERO] THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; normalize] THEN
+ ASM_CASES_TAC `normalize t = []` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[NOT_CONS_NIL] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL]);;
+
+let POLY_NORMALIZE_EQ_LEMMA = prove
+ (`!p q. (poly p = poly q) ==> (normalize p = normalize q)`,
+ LIST_INDUCT_TAC THENL
+ [MESON_TAC[POLY_NORMALIZE_ZERO]; ALL_TAC] THEN
+ LIST_INDUCT_TAC THENL
+ [MESON_TAC[POLY_NORMALIZE_ZERO]; ALL_TAC] THEN
+ REWRITE_TAC[POLY_CONS_EQ] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[normalize] THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `t':complex list`) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN SUBST1_TAC THEN REFL_TAC);;
+
+let POLY_NORMALIZE_EQ = prove
+ (`!p q. (poly p = poly q) <=> (normalize p = normalize q)`,
+ MESON_TAC[POLY_NORMALIZE_EQ_LEMMA; POLY_NORMALIZE]);;
+
+let DEGREE_WELLDEF = prove
+ (`!p q. (poly p = poly q) ==> (degree p = degree q)`,
+ SIMP_TAC[degree; POLY_NORMALIZE_EQ]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Degree of a product with a power of linear terms. *)
+(* ------------------------------------------------------------------------- *)
+
+let NORMALIZE_EQ = prove
+ (`!p. ~(LAST p = Cx(&0)) ==> (normalize p = p)`,
+ MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN
+ REWRITE_TAC[normalize; LAST] THEN REPEAT GEN_TAC THEN
+ REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[normalize]));;
+
+let NORMAL_DEGREE = prove
+ (`!p. ~(LAST p = Cx(&0)) ==> (degree p = LENGTH p - 1)`,
+ SIMP_TAC[degree; NORMALIZE_EQ] THEN REPEAT STRIP_TAC THEN ARITH_TAC);;
+
+let LAST_LINEAR_MUL_LEMMA = prove
+ (`!p a b x.
+ LAST(a ## p ++ CONS x (b ## p)) = if p = [] then x else b * LAST(p)`,
+ LIST_INDUCT_TAC THEN
+ REWRITE_TAC[poly_cmul; poly_add; LAST; HD; TL; NOT_CONS_NIL] THEN
+ REPEAT GEN_TAC THEN
+ SUBGOAL_THEN `~(a ## t ++ CONS (b * h) (b ## t) = [])`
+ ASSUME_TAC THENL
+ [SPEC_TAC(`t:complex list`,`t:complex list`) THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL];
+ ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);;
+
+let LAST_LINEAR_MUL = prove
+ (`!p. ~(p = []) ==> (LAST([a; Cx(&1)] ** p) = LAST p)`,
+ SIMP_TAC[poly_mul; NOT_CONS_NIL; LAST_LINEAR_MUL_LEMMA; COMPLEX_MUL_LID]);;
+
+let NORMAL_NORMALIZE = prove
+ (`!p. ~(normalize p = []) ==> ~(LAST(normalize p) = Cx(&0))`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[normalize] THEN
+ POP_ASSUM MP_TAC THEN ASM_CASES_TAC `normalize t = []` THEN
+ ASM_REWRITE_TAC[LAST; NOT_CONS_NIL] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[LAST]);;
+
+let LINEAR_MUL_DEGREE = prove
+ (`!p a. ~(poly p = poly []) ==> (degree([a; Cx(&1)] ** p) = degree(p) + 1)`,
+ REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `degree([a; Cx(&1)] ** normalize p) = degree(normalize p) + 1`
+ MP_TAC THENL
+ [FIRST_ASSUM(ASSUME_TAC o
+ GEN_REWRITE_RULE RAND_CONV [POLY_NORMALIZE_ZERO]) THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP NORMAL_NORMALIZE) THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP LAST_LINEAR_MUL) THEN
+ SIMP_TAC[NORMAL_DEGREE] THEN REPEAT STRIP_TAC THEN
+ SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX_NEG_NEG)) THEN
+ REWRITE_TAC[POLY_LENGTH_MUL] THEN
+ UNDISCH_TAC `~(normalize p = [])` THEN
+ SPEC_TAC(`normalize p`,`p:complex list`) THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL; LENGTH] THEN ARITH_TAC;
+ MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN
+ TRY(AP_THM_TAC THEN AP_TERM_TAC) THEN MATCH_MP_TAC DEGREE_WELLDEF THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_NORMALIZE]]);;
+
+let LINEAR_POW_MUL_DEGREE = prove
+ (`!n a p. degree([a; Cx(&1)] exp n ** p) =
+ if poly p = poly [] then 0 else degree p + n`,
+ INDUCT_TAC THEN REWRITE_TAC[poly_exp] THENL
+ [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
+ [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree(p)` THEN CONJ_TAC THENL
+ [MATCH_MP_TAC DEGREE_WELLDEF THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO;
+ COMPLEX_ADD_RID; COMPLEX_MUL_LID];
+ MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree []` THEN CONJ_TAC THENL
+ [MATCH_MP_TAC DEGREE_WELLDEF THEN ASM_REWRITE_TAC[];
+ REWRITE_TAC[degree; LENGTH; normalize; ARITH]]];
+ REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC DEGREE_WELLDEF THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO;
+ COMPLEX_ADD_RID; COMPLEX_MUL_LID]];
+ ALL_TAC] THEN
+ REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
+ EXISTS_TAC `degree([a; Cx (&1)] exp n ** ([a; Cx (&1)] ** p))` THEN
+ CONJ_TAC THENL
+ [MATCH_MP_TAC DEGREE_WELLDEF THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_AC]; ALL_TAC] THEN
+ ASM_REWRITE_TAC[POLY_ENTIRE] THEN
+ ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THEN
+ ASM_SIMP_TAC[LINEAR_MUL_DEGREE] THEN
+ SUBGOAL_THEN `~(poly [a; Cx (&1)] = poly [])`
+ (fun th -> REWRITE_TAC[th] THEN ARITH_TAC) THEN
+ REWRITE_TAC[POLY_NORMALIZE_EQ] THEN
+ REWRITE_TAC[normalize; CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_CONS_NIL]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Show that the order of a root (or nonroot!) is bounded by degree. *)
+(* ------------------------------------------------------------------------- *)
+
+let ORDER_DEGREE = prove
+ (`!a p. ~(poly p = poly []) ==> order a p <= degree p`,
+ REPEAT STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN
+ DISCH_THEN(MP_TAC o REWRITE_RULE[divides] o CONJUNCT1) THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:complex list` ASSUME_TAC) THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN
+ ASM_REWRITE_TAC[LINEAR_POW_MUL_DEGREE] THEN
+ FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[POLY_MUL] THENL
+ [UNDISCH_TAC `~(poly p = poly [])` THEN
+ SIMP_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO];
+ DISCH_TAC THEN ARITH_TAC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Tidier versions of finiteness of roots. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_ROOTS_FINITE_SET = prove
+ (`!p. ~(poly p = poly []) ==> FINITE { x | poly p x = Cx(&0)}`,
+ GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN
+ DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `i:num->complex` ASSUME_TAC) THEN
+ MATCH_MP_TAC FINITE_SUBSET THEN
+ EXISTS_TAC `{x:complex | ?n:num. n < N /\ (x = i n)}` THEN
+ CONJ_TAC THENL
+ [SPEC_TAC(`N:num`,`N:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN
+ INDUCT_TAC THENL
+ [SUBGOAL_THEN `{x:complex | ?n. n < 0 /\ (x = i n)} = {}`
+ (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN
+ REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT];
+ SUBGOAL_THEN `{x:complex | ?n. n < SUC N /\ (x = i n)} =
+ (i N) INSERT {x:complex | ?n. n < N /\ (x = i n)}`
+ SUBST1_TAC THENL
+ [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LT] THEN MESON_TAC[];
+ MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN ASM_REWRITE_TAC[]]];
+ ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Conversions to perform operations if coefficients are rational constants. *)
+(* ------------------------------------------------------------------------- *)
+
+let COMPLEX_RAT_MUL_CONV =
+ GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;;
+
+let COMPLEX_RAT_ADD_CONV =
+ GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;;
+
+let COMPLEX_RAT_EQ_CONV =
+ GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;;
+
+let POLY_CMUL_CONV =
+ let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul]
+ and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] in
+ let rec POLY_CMUL_CONV tm =
+ (cmul_conv0 ORELSEC
+ (cmul_conv1 THENC
+ LAND_CONV COMPLEX_RAT_MUL_CONV THENC
+ RAND_CONV POLY_CMUL_CONV)) tm in
+ POLY_CMUL_CONV;;
+
+let POLY_ADD_CONV =
+ let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES))
+ and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] in
+ let rec POLY_ADD_CONV tm =
+ (add_conv0 ORELSEC
+ (add_conv1 THENC
+ LAND_CONV COMPLEX_RAT_ADD_CONV THENC
+ RAND_CONV POLY_ADD_CONV)) tm in
+ POLY_ADD_CONV;;
+
+let POLY_MUL_CONV =
+ let mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES]
+ and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)]
+ and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] in
+ let rec POLY_MUL_CONV tm =
+ (mul_conv0 ORELSEC
+ (mul_conv1 THENC POLY_CMUL_CONV) ORELSEC
+ (mul_conv2 THENC
+ LAND_CONV POLY_CMUL_CONV THENC
+ RAND_CONV(RAND_CONV POLY_MUL_CONV) THENC
+ POLY_ADD_CONV)) tm in
+ POLY_MUL_CONV;;
+
+let POLY_NORMALIZE_CONV =
+ let pth = prove
+ (`normalize (CONS h t) =
+ (\n. if n = [] then if h = Cx(&0) then [] else [h] else CONS h n)
+ (normalize t)`,
+ REWRITE_TAC[normalize]) in
+ let norm_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 normalize]
+ and norm_conv1 = GEN_REWRITE_CONV I [pth]
+ and norm_conv2 = GEN_REWRITE_CONV DEPTH_CONV
+ [COND_CLAUSES; NOT_CONS_NIL; EQT_INTRO(SPEC_ALL EQ_REFL)] in
+ let rec POLY_NORMALIZE_CONV tm =
+ (norm_conv0 ORELSEC
+ (norm_conv1 THENC
+ RAND_CONV POLY_NORMALIZE_CONV THENC
+ BETA_CONV THENC
+ RATOR_CONV(RAND_CONV(RATOR_CONV(LAND_CONV COMPLEX_RAT_EQ_CONV))) THENC
+ norm_conv2)) tm in
+ POLY_NORMALIZE_CONV;;
+
+(* ------------------------------------------------------------------------- *)
+(* Now we're finished with polynomials... *)
+(* ------------------------------------------------------------------------- *)
+
+(************** keep this for now
+
+do_list reduce_interface
+ ["divides",`poly_divides:complex list->complex list->bool`;
+ "exp",`poly_exp:complex list -> num -> complex list`;
+ "diff",`poly_diff:complex list->complex list`];;
+
+unparse_as_infix "exp";;
+
+ ****************)
--- /dev/null
+(* ========================================================================= *)
+(* Fundamental theorem of algebra. *)
+(* ========================================================================= *)
+
+needs "Complex/complex_transc.ml";;
+needs "Complex/cpoly.ml";;
+
+prioritize_complex();;
+
+(* ------------------------------------------------------------------------- *)
+(* A cute trick to reduce magnitude of unimodular number. *)
+(* ------------------------------------------------------------------------- *)
+
+let SQRT_SOS_LT_1 = prove
+ (`!x y. sqrt(x pow 2 + y pow 2) < &1 <=> x pow 2 + y pow 2 < &1`,
+ REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN
+ REWRITE_TAC[REAL_POW_2] THEN
+ SIMP_TAC[SQRT_MONO_LT_EQ; REAL_POS; REAL_LE_ADD; REAL_LE_SQUARE]);;
+
+let SQRT_SOS_EQ_1 = prove
+ (`!x y. (sqrt(x pow 2 + y pow 2) = &1) <=> (x pow 2 + y pow 2 = &1)`,
+ REPEAT GEN_TAC THEN
+ GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN
+ REWRITE_TAC[REAL_POW_2] THEN
+ SIMP_TAC[SQRT_INJ; REAL_POS; REAL_LE_ADD; REAL_LE_SQUARE]);;
+
+let UNIMODULAR_REDUCE_NORM = prove
+ (`!z. (norm(z) = &1)
+ ==> norm(z + Cx(&1)) < &1 \/
+ norm(z - Cx(&1)) < &1 \/
+ norm(z + ii) < &1 \/
+ norm(z - ii) < &1`,
+ GEN_TAC THEN
+ REWRITE_TAC[ii; CX_DEF; complex_add; complex_sub; complex_neg; complex_norm;
+ RE; IM; REAL_ADD_RID; REAL_NEG_0; SQRT_SOS_LT_1; SQRT_SOS_EQ_1] THEN
+ SIMP_TAC[REAL_POW_2;
+ REAL_ARITH `a * a + (b + c) * (b + c) =
+ (a * a + b * b) + (&2 * b * c + c * c)`;
+ REAL_ARITH `(b + c) * (b + c) + a * a =
+ (b * b + a * a) + (&2 * b * c + c * c)`] THEN
+ DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `&1 + x < &1 <=> &0 < --x`] THEN
+ REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN
+ REWRITE_TAC[REAL_MUL_RID] THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `~(abs(a) <= &1 /\ abs(b) <= &1)
+ ==> &0 < --a + --(&1) \/ &0 < a + --(&1) \/
+ &0 < --b + --(&1) \/ &0 < b + --(&1)`) THEN
+ STRIP_TAC THEN UNDISCH_TAC `Re z * Re z + Im z * Im z = &1` THEN
+ REWRITE_TAC[] THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `(&2 * r) * (&2 * r) <= &1 /\ (&2 * i) * (&2 * i) <= &1
+ ==> ~(r * r + i * i = &1)`) THEN
+ REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
+ ASM_SIMP_TAC[REAL_POW_1_LE; REAL_ABS_POS]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence we can always reduce modulus of 1 + b z^n if nonzero *)
+(* ------------------------------------------------------------------------- *)
+
+let REDUCE_POLY_SIMPLE = prove
+ (`!b n. ~(b = Cx(&0)) /\ ~(n = 0)
+ ==> ?z. norm(Cx(&1) + b * z pow n) < &1`,
+ GEN_TAC THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN
+ ASM_CASES_TAC `EVEN(n)` THENL
+ [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
+ ASM_SIMP_TAC[ARITH_RULE `~(2 * m = 0) ==> m < 2 * m /\ ~(m = 0)`] THEN
+ DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN EXISTS_TAC `csqrt w` THEN
+ ASM_REWRITE_TAC[GSYM COMPLEX_POW_POW; CSQRT]; ALL_TAC] THEN
+ MP_TAC(SPEC `Cx(norm b) / b` UNIMODULAR_REDUCE_NORM) THEN ANTS_TAC THENL
+ [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN
+ ASM_SIMP_TAC[COMPLEX_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO];
+ ALL_TAC] THEN DISCH_TAC THEN
+ SUBGOAL_THEN `?v. norm(Cx(norm b) / b + v pow n) < &1` MP_TAC THENL
+ [SUBGOAL_THEN `(Cx(&1) pow n = Cx(&1)) /\
+ (--Cx(&1) pow n = --Cx(&1)) /\
+ (((ii pow n = ii) /\ (--ii pow n = --ii)) \/
+ ((ii pow n = --ii) /\ (--ii pow n = ii)))`
+ MP_TAC THENL
+ [ALL_TAC;
+ RULE_ASSUM_TAC(REWRITE_RULE[complex_sub]) THEN ASM_MESON_TAC[]] THEN
+ FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN
+ SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN
+ X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN
+ REWRITE_TAC[complex_pow; COMPLEX_POW_NEG; EVEN; EVEN_MULT; ARITH_EVEN] THEN
+ REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN
+ REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_POW_II_2; COMPLEX_MUL_LID;
+ COMPLEX_POW_NEG] THEN
+ COND_CASES_TAC THEN
+ REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG];
+ ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `v:complex` ASSUME_TAC) THEN
+ EXISTS_TAC `v / Cx(root(n) (norm b))` THEN
+ REWRITE_TAC[COMPLEX_POW_DIV; GSYM CX_POW] THEN
+ SUBGOAL_THEN `root n (norm b) pow n = norm b` SUBST1_TAC THENL
+ [UNDISCH_TAC `~(EVEN n)` THEN SPEC_TAC(`n:num`,`n:num`) THEN
+ INDUCT_TAC THEN SIMP_TAC[EVEN; ROOT_POW_POS; COMPLEX_NORM_POS];
+ ALL_TAC] THEN
+ MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `norm(Cx(norm b) / b)` THEN
+ REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_ADD_LDISTRIB] THEN
+ REWRITE_TAC[COMPLEX_MUL_RID; REAL_MUL_RID] THEN
+ SUBGOAL_THEN `norm(Cx(norm b) / b) = &1` SUBST1_TAC THENL
+ [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; COMPLEX_ABS_NORM] THEN
+ ASM_SIMP_TAC[REAL_DIV_REFL; COMPLEX_NORM_ZERO]; ALL_TAC] THEN
+ REWRITE_TAC[REAL_LT_01; complex_div] THEN
+ ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC
+ `(m * b') * b * p * m' = (m * m') * (b * b') * p`] THEN
+ ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LID;
+ CX_INJ; COMPLEX_NORM_ZERO] THEN
+ ASM_REWRITE_TAC[GSYM complex_div]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Basic lemmas about polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_CMUL_MAP = prove
+ (`!p c x. poly (MAP (( * ) c) p) x = c * poly p x`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; poly; COMPLEX_MUL_RZERO] THEN
+ ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN REWRITE_TAC[COMPLEX_MUL_AC]);;
+
+let POLY_0 = prove
+ (`!p x. ALL (\b. b = Cx(&0)) p ==> (poly p x = Cx(&0))`,
+ LIST_INDUCT_TAC THEN
+ ASM_SIMP_TAC[ALL; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]);;
+
+let POLY_BOUND_EXISTS = prove
+ (`!p r. ?m. &0 < m /\ !z. norm(z) <= r ==> norm(poly p z) <= m`,
+ ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
+ LIST_INDUCT_TAC THENL
+ [EXISTS_TAC `&1` THEN REWRITE_TAC[poly; COMPLEX_NORM_CX] THEN
+ REWRITE_TAC[REAL_ABS_NUM; REAL_LT_01; REAL_POS]; ALL_TAC] THEN
+ POP_ASSUM(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN
+ EXISTS_TAC `&1 + norm(h) + abs(r * m)` THEN
+ ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 < &1 + x + y`;
+ REAL_ABS_POS; COMPLEX_NORM_POS] THEN
+ X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
+ REWRITE_TAC[poly] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
+ EXISTS_TAC `norm(h) + norm(z * poly t z)` THEN
+ REWRITE_TAC[COMPLEX_NORM_TRIANGLE] THEN
+ MATCH_MP_TAC(REAL_ARITH `y <= z ==> x + y <= &1 + x + abs(z)`) THEN
+ REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
+ ASM_SIMP_TAC[COMPLEX_NORM_POS]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Offsetting the variable in a polynomial gives another of same degree. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_OFFSET_LEMMA = prove
+ (`!a p. ?b q. (LENGTH q = LENGTH p) /\
+ !x. poly (CONS b q) x = (a + x) * poly p x`,
+ GEN_TAC THEN LIST_INDUCT_TAC THENL
+ [EXISTS_TAC `Cx(&0)` THEN EXISTS_TAC `[]:complex list` THEN
+ REWRITE_TAC[poly; LENGTH; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID];
+ ALL_TAC] THEN
+ POP_ASSUM STRIP_ASSUME_TAC THEN
+ EXISTS_TAC `a * h` THEN EXISTS_TAC `CONS (b + h) q` THEN
+ ASM_REWRITE_TAC[LENGTH; poly] THEN X_GEN_TAC `x:complex ` THEN
+ FIRST_ASSUM(MP_TAC o SPEC `x:complex`) THEN
+ REWRITE_TAC[poly] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) x`) THEN
+ SIMPLE_COMPLEX_ARITH_TAC);;
+
+let POLY_OFFSET = prove
+ (`!a p. ?q. (LENGTH q = LENGTH p) /\ !x. poly q x = poly p (a + x)`,
+ GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; poly] THENL
+ [EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; LENGTH]; ALL_TAC] THEN
+ POP_ASSUM(X_CHOOSE_THEN `p:complex list` (STRIP_ASSUME_TAC o GSYM)) THEN
+ ASM_REWRITE_TAC[] THEN
+ MP_TAC(SPECL [`a:complex`; `p:complex list`] POLY_OFFSET_LEMMA) THEN
+ DISCH_THEN(X_CHOOSE_THEN `b:complex` (X_CHOOSE_THEN `r: complex list`
+ (STRIP_ASSUME_TAC o GSYM))) THEN
+ EXISTS_TAC `CONS (h + b) r` THEN ASM_REWRITE_TAC[LENGTH] THEN
+ REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC);;
+
+(* ------------------------------------------------------------------------- *)
+(* Bolzano-Weierstrass type property for closed disc in complex plane. *)
+(* ------------------------------------------------------------------------- *)
+
+let METRIC_BOUND_LEMMA = prove
+ (`!x y. norm(x - y) <= abs(Re(x) - Re(y)) + abs(Im(x) - Im(y))`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm] THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `a <= abs(abs x + abs y) ==> a <= abs x + abs y`) THEN
+ GEN_REWRITE_TAC RAND_CONV [GSYM POW_2_SQRT_ABS] THEN
+ MATCH_MP_TAC SQRT_MONO_LE THEN
+ SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN
+ REWRITE_TAC[complex_add; complex_sub; complex_neg; RE; IM] THEN
+ REWRITE_TAC[GSYM real_sub] THEN
+ REWRITE_TAC[REAL_ARITH `(a + b) * (a + b) = a * a + b * b + &2 * a * b`] THEN
+ REWRITE_TAC[GSYM REAL_ABS_MUL] THEN
+ REWRITE_TAC[REAL_ARITH `a + b <= abs a + abs b + &2 * abs c`]);;
+
+let BOLZANO_WEIERSTRASS_COMPLEX_DISC = prove
+ (`!s r. (!n. norm(s n) <= r)
+ ==> ?f z. subseq f /\
+ !e. &0 < e ==> ?N. !n. n >= N ==> norm(s(f n) - z) < e`,
+ REPEAT STRIP_TAC THEN
+ MP_TAC(SPEC `Re o (s:num->complex)` SEQ_MONOSUB) THEN
+ DISCH_THEN(X_CHOOSE_THEN `f:num->num` MP_TAC) THEN
+ REWRITE_TAC[o_THM] THEN STRIP_TAC THEN
+ MP_TAC(SPEC `Im o (s:num->complex) o (f:num->num)` SEQ_MONOSUB) THEN
+ DISCH_THEN(X_CHOOSE_THEN `g:num->num` MP_TAC) THEN
+ REWRITE_TAC[o_THM] THEN STRIP_TAC THEN
+ EXISTS_TAC `(f:num->num) o (g:num->num)` THEN
+ SUBGOAL_THEN `convergent (\n. Re(s(f n :num))) /\
+ convergent (\n. Im(s((f:num->num)(g n))))`
+ MP_TAC THENL
+ [CONJ_TAC THEN MATCH_MP_TAC SEQ_BCONV THEN ASM_REWRITE_TAC[bounded] THEN
+ MAP_EVERY EXISTS_TAC [`r + &1`; `&0`; `0`] THEN
+ REWRITE_TAC[GE; LE_0; MR1_DEF; REAL_SUB_LZERO; REAL_ABS_NEG] THEN
+ X_GEN_TAC `n:num` THEN
+ W(fun (_,w) -> FIRST_ASSUM(MP_TAC o SPEC (funpow 3 rand (lhand w)))) THEN
+ REWRITE_TAC[complex_norm] THEN
+ MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= r ==> a < r + &1`) THEN
+ GEN_REWRITE_TAC LAND_CONV [GSYM POW_2_SQRT_ABS] THEN
+ MATCH_MP_TAC SQRT_MONO_LE THEN
+ REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADDR; REAL_LE_ADDL];
+ ALL_TAC] THEN
+ REWRITE_TAC[convergent; SEQ; GE] THEN
+ DISCH_THEN(CONJUNCTS_THEN2
+ (X_CHOOSE_TAC `x:real`) (X_CHOOSE_TAC `y:real`)) THEN
+ EXISTS_TAC `complex(x,y)` THEN CONJ_TAC THENL
+ [MAP_EVERY UNDISCH_TAC [`subseq f`; `subseq g`] THEN
+ REWRITE_TAC[subseq; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN
+ X_GEN_TAC `e:real` THEN DISCH_TAC THEN
+ UNDISCH_TAC
+ `!e. &0 < e
+ ==> (?N. !n. N <= n ==> abs(Re(s ((f:num->num) n)) - x) < e)` THEN
+ DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
+ ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
+ DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN
+ EXISTS_TAC `N1 + N2:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
+ MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * e / &2` THEN
+ CONJ_TAC THENL
+ [ALL_TAC;
+ SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; REAL_LE_REFL]] THEN
+ W(MP_TAC o PART_MATCH lhand METRIC_BOUND_LEMMA o lhand o snd) THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `a < c /\ b < c ==> x <= a + b ==> x < &2 * c`) THEN
+ REWRITE_TAC[o_THM; RE; IM] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ ASM_MESON_TAC[LE_ADD; SEQ_SUBLE; LE_TRANS; ADD_SYM]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Polynomial is continuous. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_CONT = prove
+ (`!p z e. &0 < e
+ ==> ?d. &0 < d /\ !w. &0 < norm(w - z) /\ norm(w - z) < d
+ ==> norm(poly p w - poly p z) < e`,
+ REPEAT STRIP_TAC THEN
+ MP_TAC(SPECL [`z:complex`; `p:complex list`] POLY_OFFSET) THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:complex list` (MP_TAC o CONJUNCT2)) THEN
+ DISCH_THEN(MP_TAC o GEN `w:complex` o SYM o SPEC `w - z`) THEN
+ REWRITE_TAC[COMPLEX_SUB_ADD2] THEN
+ DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN
+ REWRITE_TAC[COMPLEX_SUB_REFL] THEN
+ SPEC_TAC(`q:complex list`,`p:complex list`) THEN
+ LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly] THENL
+ [EXISTS_TAC `e:real` THEN
+ ASM_REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_CX; REAL_ABS_NUM];
+ ALL_TAC] THEN
+ REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; COMPLEX_ADD_SUB] THEN
+ MP_TAC(SPECL [`t:complex list`; `&1`] POLY_BOUND_EXISTS) THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN
+ MP_TAC(SPECL [`&1`; `e / m:real`] REAL_DOWN2) THEN
+ ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_01] THEN
+ MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN
+ STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN
+ MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d * m:real` THEN
+ ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
+ ASM_MESON_TAC[REAL_LT_TRANS; REAL_LT_IMP_LE; COMPLEX_NORM_POS]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence a polynomial attains minimum on a closed disc in the complex plane. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_MINIMUM_MODULUS_DISC = prove
+ (`!p r. ?z. !w. norm(w) <= r ==> norm(poly p z) <= norm(poly p w)`,
+ let lemma = prove
+ (`P /\ (m = --x) /\ --x < y <=> (--x = m) /\ P /\ m < y`,
+ MESON_TAC[]) in
+ REPEAT GEN_TAC THEN
+ ASM_CASES_TAC `&0 <= r` THENL
+ [ALL_TAC; ASM_MESON_TAC[COMPLEX_NORM_POS; REAL_LE_TRANS]] THEN
+ MP_TAC(SPEC `\x. ?z. norm(z) <= r /\ (norm(poly p z) = --x)`
+ REAL_SUP_EXISTS) THEN
+ REWRITE_TAC[] THEN ANTS_TAC THENL
+ [CONJ_TAC THENL
+ [MAP_EVERY EXISTS_TAC [`--norm(poly p (Cx(&0)))`; `Cx(&0)`] THEN
+ ASM_REWRITE_TAC[REAL_NEG_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM];
+ EXISTS_TAC `&1` THEN
+ REWRITE_TAC[REAL_ARITH `(a = --b) <=> (--b = a:real)`] THEN
+ REWRITE_TAC[REAL_ARITH `x < &1 <=> --(&1) < --x`] THEN
+ SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN
+ SIMP_TAC[REAL_ARITH `&0 <= x ==> --(&1) < x`; COMPLEX_NORM_POS]];
+ ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:real` MP_TAC) THEN
+ ONCE_REWRITE_TAC[REAL_ARITH `a < b <=> --b < --a:real`] THEN
+ ABBREV_TAC `m = --s:real` THEN
+ DISCH_THEN(MP_TAC o GEN `y:real` o SPEC `--y:real`) THEN
+ REWRITE_TAC[REAL_NEG_NEG] THEN
+ REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; lemma] THEN
+ ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
+ ONCE_REWRITE_TAC[REAL_ARITH `(--a = b) <=> (a = --b:real)`] THEN
+ REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN
+ DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `m:real` th)) THEN
+ REWRITE_TAC[REAL_LT_REFL; NOT_EXISTS_THM] THEN
+ REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN
+ REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
+ DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `m + inv(&(SUC n))`) THEN
+ REWRITE_TAC[REAL_LT_ADDR; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0] THEN
+ REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:num->complex` STRIP_ASSUME_TAC) THEN
+ MP_TAC(SPECL [`s:num->complex`; `r:real`]
+ BOLZANO_WEIERSTRASS_COMPLEX_DISC) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_THEN `f:num->num` (X_CHOOSE_THEN `z:complex`
+ STRIP_ASSUME_TAC)) THEN
+ EXISTS_TAC `z:complex` THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
+ SUBGOAL_THEN `norm(poly p z) = m` (fun th -> ASM_SIMP_TAC[th]) THEN
+ MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(a - b)) ==> (a = b)`) THEN DISCH_TAC THEN
+ ABBREV_TAC `e = abs(norm(poly p z) - m)` THEN
+ MP_TAC(SPECL [`p:complex list`; `z:complex`; `e / &2`] POLY_CONT) THEN
+ ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
+ DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
+ SUBGOAL_THEN `!w. norm(w - z) < d ==> norm(poly p w - poly p z) < e / &2`
+ MP_TAC THENL
+ [X_GEN_TAC `u:complex` THEN
+ ASM_CASES_TAC `u = z:complex` THEN
+ ASM_SIMP_TAC[COMPLEX_SUB_REFL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH;
+ COMPLEX_NORM_CX; REAL_ABS_NUM] THEN
+ DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
+ ASM_REWRITE_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0]; ALL_TAC] THEN
+ FIRST_ASSUM(K ALL_TAC o check (is_conj o lhand o
+ snd o dest_forall o concl)) THEN
+ DISCH_TAC THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[GE] THEN
+ DISCH_THEN(X_CHOOSE_THEN `N1:num` ASSUME_TAC) THEN
+ MP_TAC(SPEC `&2 / e` REAL_ARCH_SIMPLE) THEN
+ DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN
+ SUBGOAL_THEN `norm(poly p (s((f:num->num) (N1 + N2))) - poly p z) < e / &2`
+ MP_TAC THENL
+ [FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LE_ADD]; ALL_TAC] THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `!m. abs(norm(psfn) - m) < e2 /\
+ &2 * e2 <= abs(norm(psfn) - m) + norm(psfn - pz)
+ ==> norm(psfn - pz) < e2 ==> F`) THEN
+ EXISTS_TAC `m:real` THEN CONJ_TAC THENL
+ [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&(SUC(N1 + N2)))` THEN
+ CONJ_TAC THENL
+ [MATCH_MP_TAC(REAL_ARITH
+ `m <= x /\ x < m + e ==> abs(x - m:real) < e`) THEN
+ ASM_SIMP_TAC[] THEN
+ MATCH_MP_TAC REAL_LTE_TRANS THEN
+ EXISTS_TAC `m + inv(&(SUC(f(N1 + N2:num))))` THEN
+ ASM_REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
+ ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0; LE_SUC; SEQ_SUBLE];
+ GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN
+ MATCH_MP_TAC REAL_LE_INV2 THEN
+ ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
+ MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N2` THEN
+ ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]; ALL_TAC] THEN
+ SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN
+ EXPAND_TAC "e" THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `abs(norm(psfn) - norm(pz)) <= norm(psfn - pz)
+ ==> abs(norm(pz) - m) <= abs(norm(psfn) - m) + norm(psfn - pz)`) THEN
+ REWRITE_TAC[COMPLEX_NORM_ABS_NORM]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Nonzero polynomial in z goes to infinity as z does. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_INFINITY = prove
+ (`!p a. EX (\b. ~(b = Cx(&0))) p
+ ==> !d. ?r. !z. r <= norm(z) ==> d <= norm(poly (CONS a p) z)`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[EX] THEN X_GEN_TAC `a:complex` THEN
+ ASM_CASES_TAC `EX (\b. ~(b = Cx(&0))) t` THEN ASM_REWRITE_TAC[] THENL
+ [X_GEN_TAC `d:real` THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `h:complex`) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_TAC `r:real` o SPEC `d + norm(a)`) THEN
+ EXISTS_TAC `&1 + abs(r)` THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
+ ONCE_REWRITE_TAC[poly] THEN
+ MATCH_MP_TAC REAL_LE_TRANS THEN
+ EXISTS_TAC `norm(z * poly (CONS h t) z) - norm(a)` THEN CONJ_TAC THENL
+ [ALL_TAC;
+ ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN
+ REWRITE_TAC[REAL_LE_SUB_RADD; COMPLEX_NORM_TRIANGLE_SUB]] THEN
+ REWRITE_TAC[REAL_LE_SUB_LADD] THEN
+ MATCH_MP_TAC REAL_LE_TRANS THEN
+ EXISTS_TAC `&1 * norm(poly (CONS h t) z)` THEN CONJ_TAC THENL
+ [REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ ASM_SIMP_TAC[REAL_ARITH `&1 + abs(r) <= x ==> r <= x`];
+ REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
+ REWRITE_TAC[COMPLEX_NORM_POS] THEN
+ ASM_MESON_TAC[REAL_ARITH `&1 + abs(r) <= x ==> &1 <= x`]];
+ RULE_ASSUM_TAC(REWRITE_RULE[NOT_EX]) THEN
+ ASM_SIMP_TAC[poly; POLY_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ DISCH_TAC THEN X_GEN_TAC `d:real` THEN
+ EXISTS_TAC `(abs(d) + norm(a)) / norm(h)` THEN X_GEN_TAC `z:complex` THEN
+ ASM_SIMP_TAC[REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh`) THEN
+ ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN
+ REWRITE_TAC[COMPLEX_NORM_TRIANGLE_SUB]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Hence polynomial's modulus attains its minimum somewhere. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_MINIMUM_MODULUS = prove
+ (`!p. ?z. !w. norm(poly p z) <= norm(poly p w)`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_LE_REFL] THEN
+ ASM_CASES_TAC `EX (\b. ~(b = Cx(&0))) t` THENL
+ [FIRST_ASSUM(MP_TAC o SPEC `h:complex` o MATCH_MP POLY_INFINITY) THEN
+ DISCH_THEN(MP_TAC o SPEC `norm(poly (CONS h t) (Cx(&0)))`) THEN
+ DISCH_THEN(X_CHOOSE_THEN `r:real` ASSUME_TAC) THEN
+ MP_TAC(SPECL [`CONS (h:complex) t`; `abs(r)`]
+ POLY_MINIMUM_MODULUS_DISC) THEN
+ REWRITE_TAC[GSYM(CONJUNCT2 poly)] THEN
+ ASM_MESON_TAC[REAL_ARITH `r <= z \/ z <= abs(r)`; REAL_LE_TRANS;
+ COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_POS];
+ FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN
+ REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP POLY_0) THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; REAL_LE_REFL]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Constant function (non-syntactic characterization). *)
+(* ------------------------------------------------------------------------- *)
+
+let constant = new_definition
+ `constant f = !w z. f(w) = f(z)`;;
+
+let NONCONSTANT_LENGTH = prove
+ (`!p. ~constant(poly p) ==> 2 <= LENGTH p`,
+ REWRITE_TAC[constant] THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[poly] THEN
+ REWRITE_TAC[LENGTH; ARITH_RULE `2 <= SUC n <=> ~(n = 0)`] THEN
+ SIMP_TAC[TAUT `~a ==> ~b <=> b ==> a`; LENGTH_EQ_NIL; poly] THEN
+ REWRITE_TAC[COMPLEX_MUL_RZERO]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Decomposition of polynomial, skipping zero coefficients after the first. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_DECOMPOSE_LEMMA = prove
+ (`!p. ~(!z. ~(z = Cx(&0)) ==> (poly p z = Cx(&0)))
+ ==> ?k a q. ~(a = Cx(&0)) /\
+ (SUC(LENGTH q + k) = LENGTH p) /\
+ !z. poly p z = z pow k * poly (CONS a q) z`,
+ LIST_INDUCT_TAC THENL [REWRITE_TAC[poly]; ALL_TAC] THEN
+ ASM_CASES_TAC `h = Cx(&0)` THENL
+ [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [poly] THEN
+ ASM_SIMP_TAC[COMPLEX_ADD_LID; COMPLEX_ENTIRE] THEN
+ DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
+ DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex`
+ (X_CHOOSE_THEN `q:complex list` STRIP_ASSUME_TAC))) THEN
+ MAP_EVERY EXISTS_TAC [`k + 1`; `a:complex`; `q:complex list`] THEN
+ ASM_REWRITE_TAC[poly; LENGTH; GSYM ADD1; ADD_CLAUSES] THEN
+ REWRITE_TAC[COMPLEX_ADD_LID; complex_pow; GSYM COMPLEX_MUL_ASSOC];
+ DISCH_THEN(K ALL_TAC) THEN
+ MAP_EVERY EXISTS_TAC [`0`; `h:complex`; `t:complex list`] THEN
+ ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; ADD_CLAUSES; LENGTH]]);;
+
+let POLY_DECOMPOSE = prove
+ (`!p. ~constant(poly p)
+ ==> ?k a q. ~(a = Cx(&0)) /\ ~(k = 0) /\
+ (LENGTH q + k + 1 = LENGTH p) /\
+ !z. poly p z = poly p (Cx(&0)) +
+ z pow k * poly (CONS a q) z`,
+ LIST_INDUCT_TAC THENL [REWRITE_TAC[constant; poly]; ALL_TAC] THEN
+ POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
+ MP_TAC(SPEC `t:complex list` POLY_DECOMPOSE_LEMMA) THEN ANTS_TAC THENL
+ [POP_ASSUM MP_TAC THEN REWRITE_TAC[constant; poly] THEN
+ REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`; COMPLEX_EQ_ADD_LCANCEL] THEN
+ SIMP_TAC[TAUT `~a ==> b <=> a \/ b`; GSYM COMPLEX_ENTIRE]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex`
+ (X_CHOOSE_THEN `q:complex list` STRIP_ASSUME_TAC))) THEN
+ MAP_EVERY EXISTS_TAC [`SUC k`; `a:complex`; `q:complex list`] THEN
+ ASM_REWRITE_TAC[ADD_CLAUSES; GSYM ADD1; LENGTH; NOT_SUC] THEN
+ ASM_REWRITE_TAC[poly; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN
+ REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC]);;
+
+let POLY_REPLICATE_APPEND = prove
+ (`!n p x. poly (APPEND (REPLICATE n (Cx(&0))) p) x = x pow n * poly p x`,
+ INDUCT_TAC THEN
+ REWRITE_TAC[REPLICATE; APPEND; complex_pow; COMPLEX_MUL_LID] THEN
+ ASM_REWRITE_TAC[poly; COMPLEX_ADD_LID] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Fundamental theorem. *)
+(* ------------------------------------------------------------------------- *)
+
+let FUNDAMENTAL_THEOREM_OF_ALGEBRA = prove
+ (`!p. ~constant(poly p) ==> ?z. poly p z = Cx(&0)`,
+ SUBGOAL_THEN
+ `!n p. (LENGTH p = n) /\ ~constant(poly p) ==> ?z. poly p z = Cx(&0)`
+ (fun th -> MESON_TAC[th]) THEN
+ MATCH_MP_TAC num_WF THEN
+ X_GEN_TAC `n:num` THEN STRIP_TAC THEN
+ X_GEN_TAC `p:complex list` THEN STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP NONCONSTANT_LENGTH) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
+ X_CHOOSE_TAC `c:complex` (SPEC `p:complex list` POLY_MINIMUM_MODULUS) THEN
+ ASM_CASES_TAC `poly p c = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
+ MP_TAC(SPECL [`c:complex`; `p:complex list`] POLY_OFFSET) THEN
+ DISCH_THEN(X_CHOOSE_THEN `q:complex list` MP_TAC) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) ASSUME_TAC) THEN
+ SUBGOAL_THEN `~constant(poly q)` ASSUME_TAC THENL
+ [UNDISCH_TAC `~(constant(poly p))` THEN
+ SUBGOAL_THEN `!z. poly q (z - c) = poly p z`
+ (fun th -> MESON_TAC[th; constant]) THEN
+ ASM_MESON_TAC[SIMPLE_COMPLEX_ARITH `a + (x - a) = x`]; ALL_TAC] THEN
+ SUBGOAL_THEN `poly p c = poly q (Cx(&0))` SUBST_ALL_TAC THENL
+ [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN
+ SUBGOAL_THEN `!w. norm(poly q (Cx(&0))) <= norm(poly q w)` MP_TAC THENL
+ [ASM_MESON_TAC[]; ALL_TAC] THEN
+ POP_ASSUM_LIST(MAP_EVERY (fun th ->
+ if free_in `p:complex list` (concl th)
+ then ALL_TAC else ASSUME_TAC th)) THEN
+ MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN
+ REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN
+ ABBREV_TAC `a0 = poly q (Cx(&0))` THEN
+ SUBGOAL_THEN
+ `!z. poly q z = poly (MAP (( * ) (inv(a0))) q) z * a0`
+ ASSUME_TAC THENL
+ [REWRITE_TAC[POLY_CMUL_MAP] THEN
+ ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `(a * b) * c = b * c * a`] THEN
+ ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_RID];
+ ALL_TAC] THEN
+ ABBREV_TAC `r = MAP (( * ) (inv(a0))) q` THEN
+ SUBGOAL_THEN `LENGTH(q:complex list) = LENGTH(r:complex list)`
+ SUBST_ALL_TAC THENL
+ [EXPAND_TAC "r" THEN REWRITE_TAC[LENGTH_MAP]; ALL_TAC] THEN
+ SUBGOAL_THEN `~(constant(poly r))` ASSUME_TAC THENL
+ [UNDISCH_TAC `~constant(poly q)` THEN
+ ASM_REWRITE_TAC[constant; COMPLEX_EQ_MUL_RCANCEL] THEN MESON_TAC[];
+ ALL_TAC] THEN
+ SUBGOAL_THEN `poly r (Cx(&0)) = Cx(&1)` ASSUME_TAC THENL
+ [FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN
+ ASM_REWRITE_TAC[] THEN
+ GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM COMPLEX_MUL_LID] THEN
+ ASM_SIMP_TAC[COMPLEX_EQ_MUL_RCANCEL]; ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN
+ POP_ASSUM_LIST(MAP_EVERY (fun th ->
+ if free_in `q:complex list` (concl th)
+ then ALL_TAC else ASSUME_TAC th)) THEN
+ ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; COMPLEX_NORM_NZ; COMPLEX_NORM_MUL;
+ REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP POLY_DECOMPOSE) THEN
+ DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex`
+ (X_CHOOSE_THEN `s:complex list` MP_TAC))) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+ DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) MP_TAC) THEN
+ DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[] THEN
+ ASM_CASES_TAC `k + 1 = n` THENL
+ [UNDISCH_TAC `LENGTH(s:complex list) + k + 1 = n` THEN
+ ASM_REWRITE_TAC[ARITH_RULE `(s + m = m) <=> (s = 0)`; LENGTH_EQ_NIL] THEN
+ REWRITE_TAC[LENGTH_EQ_NIL] THEN DISCH_THEN SUBST1_TAC THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN
+ MATCH_MP_TAC REDUCE_POLY_SIMPLE THEN ASM_REWRITE_TAC[] THEN
+ MAP_EVERY UNDISCH_TAC [`k + 1 = n`; `2 <= n`] THEN ARITH_TAC; ALL_TAC] THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `k + 1`) THEN ANTS_TAC THENL
+ [UNDISCH_TAC `~(k + 1 = n)` THEN
+ UNDISCH_TAC `LENGTH(s:complex list) + k + 1 = n` THEN ARITH_TAC;
+ ALL_TAC] THEN
+ DISCH_THEN(MP_TAC o SPEC
+ `CONS (Cx(&1)) (APPEND (REPLICATE (k - 1) (Cx(&0))) [a])`) THEN
+ ANTS_TAC THENL
+ [CONJ_TAC THENL
+ [REWRITE_TAC[LENGTH; LENGTH_APPEND; LENGTH_REPLICATE] THEN
+ UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; ALL_TAC] THEN
+ REWRITE_TAC[constant; POLY_REPLICATE_APPEND; poly] THEN
+ REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(&1)`]) THEN
+ REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN
+ ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_POW_ONE; SIMPLE_COMPLEX_ARITH
+ `(a = a + b) <=> (b = Cx(&0))`] THEN
+ REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN
+ REWRITE_TAC[constant; POLY_REPLICATE_APPEND; poly] THEN
+ REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `a * b * c = (a * b) * c`] THEN
+ REWRITE_TAC[GSYM(CONJUNCT2 complex_pow)] THEN
+ ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> (SUC(k - 1) = k)`] THEN
+ DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN
+ MP_TAC(SPECL [`s:complex list`; `norm(w)`] POLY_BOUND_EXISTS) THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN
+ SUBGOAL_THEN `~(w = Cx(&0))` ASSUME_TAC THENL
+ [UNDISCH_TAC `Cx(&1) + w pow k * a = Cx(&0)` THEN
+ ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN
+ DISCH_THEN SUBST1_TAC THEN
+ UNDISCH_TAC `~(k = 0)` THEN SPEC_TAC(`k:num`,`k:num`) THEN
+ INDUCT_TAC THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_LZERO] THEN
+ REWRITE_TAC[COMPLEX_ADD_RID; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ];
+ ALL_TAC] THEN
+ MP_TAC(SPECL [`&1`; `inv(norm(w) pow (k + 1) * m)`] REAL_DOWN2) THEN
+ ASM_SIMP_TAC[REAL_LT_01; REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT;
+ COMPLEX_NORM_NZ] THEN
+ DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
+ EXISTS_TAC `Cx(t) * w` THEN REWRITE_TAC[COMPLEX_POW_MUL] THEN
+ REWRITE_TAC[COMPLEX_ADD_LDISTRIB; GSYM COMPLEX_MUL_ASSOC] THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SIMPLE_COMPLEX_ARITH
+ `(a + w = Cx(&0)) ==> (w = --a)`)) THEN
+ REWRITE_TAC[GSYM CX_NEG; GSYM CX_POW; GSYM CX_MUL] THEN
+ REWRITE_TAC[COMPLEX_ADD_ASSOC; GSYM CX_ADD] THEN
+ MATCH_MP_TAC REAL_LET_TRANS THEN
+ EXISTS_TAC `norm(Cx(&1 + t pow k * -- &1)) +
+ norm(Cx(t pow k) * w pow k * Cx t * w * poly s (Cx t * w))` THEN
+ REWRITE_TAC[COMPLEX_NORM_TRIANGLE] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN
+ MATCH_MP_TAC(REAL_ARITH
+ `&0 <= x /\ x < t /\ t <= &1 ==> abs(&1 + t * --(&1)) + x < &1`) THEN
+ REWRITE_TAC[COMPLEX_NORM_POS] THEN
+ ASM_SIMP_TAC[REAL_POW_1_LE; REAL_LT_IMP_LE] THEN
+ ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN
+ ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POW_LE] THEN
+ GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
+ MATCH_MP_TAC REAL_LT_LMUL THEN ASM_SIMP_TAC[REAL_POW_LT] THEN
+ ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `a * b * c * d = b * (c * a) * d`] THEN
+ REWRITE_TAC[GSYM(CONJUNCT2 complex_pow)] THEN
+ REWRITE_TAC[COMPLEX_NORM_MUL; ADD1; COMPLEX_NORM_CX] THEN
+ MATCH_MP_TAC REAL_LET_TRANS THEN
+ EXISTS_TAC `abs t * norm(w pow (k + 1)) * m` THEN CONJ_TAC THENL
+ [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
+ MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN
+ FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN
+ GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
+ MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN
+ ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ARITH
+ `&0 < t /\ t < &1 ==> abs(t) <= &1`]; ALL_TAC] THEN
+ ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; COMPLEX_NORM_POW;
+ REAL_POW_LT; COMPLEX_NORM_NZ] THEN
+ ASM_SIMP_TAC[real_div; REAL_MUL_LID;
+ REAL_ARITH `&0 < t /\ t < x ==> abs(t) < x`]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Alternative version with a syntactic notion of constant polynomial. *)
+(* ------------------------------------------------------------------------- *)
+
+let FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT = prove
+ (`!p. ~(?a l. ~(a = Cx(&0)) /\ ALL (\b. b = Cx(&0)) l /\ (p = CONS a l))
+ ==> ?z. poly p z = Cx(&0)`,
+ LIST_INDUCT_TAC THEN REWRITE_TAC[poly; CONS_11] THEN
+ POP_ASSUM_LIST(K ALL_TAC) THEN
+ ONCE_REWRITE_TAC[AC CONJ_ACI `a /\ b /\ c /\ d <=> c /\ d /\ a /\ b`] THEN
+ REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
+ ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_ADD_LID] THENL
+ [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]; ALL_TAC] THEN
+ DISCH_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 poly)] THEN
+ MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_ALGEBRA THEN
+ UNDISCH_TAC `~ALL (\b. b = Cx (&0)) t` THEN
+ REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN POP_ASSUM(K ALL_TAC) THEN
+ REWRITE_TAC[constant; poly; REAL_EQ_LADD] THEN
+ DISCH_THEN(MP_TAC o SPEC `Cx(&0)` o ONCE_REWRITE_RULE[SWAP_FORALL_THM]) THEN
+ REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_EQ_ADD_LCANCEL] THEN
+ REWRITE_TAC[COMPLEX_ENTIRE; TAUT `a \/ b <=> ~a ==> b`] THEN
+ SPEC_TAC(`t:complex list`,`p:complex list`) THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[ALL] THEN
+ ASM_CASES_TAC `h = Cx(&0)` THEN
+ ASM_SIMP_TAC[poly; COMPLEX_ADD_LID; COMPLEX_ENTIRE] THEN
+ MP_TAC(SPECL [`t:complex list`; `&1`] POLY_BOUND_EXISTS) THEN
+ DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN
+ MP_TAC(SPECL [`norm(h) / m`; `&1`] REAL_DOWN2) THEN
+ ASM_SIMP_TAC[REAL_LT_01; REAL_LT_DIV; COMPLEX_NORM_NZ] THEN
+ DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
+ DISCH_THEN(MP_TAC o SPEC `Cx(x)`) THEN
+ ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ] THEN
+ REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(x + y = Cx(&0)) <=> (y = --x)`] THEN
+ DISCH_THEN(MP_TAC o AP_TERM `norm`) THEN REWRITE_TAC[COMPLEX_NORM_NEG] THEN
+ MATCH_MP_TAC(REAL_ARITH `abs(a) < abs(b) ==> ~(a = b)`) THEN
+ REWRITE_TAC[real_abs; COMPLEX_NORM_POS] THEN
+ REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN
+ MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(h) / m * m` THEN
+ CONJ_TAC THENL
+ [ALL_TAC; ASM_SIMP_TAC[REAL_LE_REFL; REAL_DIV_RMUL; REAL_LT_IMP_NZ]] THEN
+ MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) * m` THEN
+ ASM_SIMP_TAC[REAL_LT_RMUL; REAL_ARITH `&0 < x /\ x < a ==> abs(x) < a`] THEN
+ ASM_MESON_TAC[REAL_LE_LMUL; REAL_ABS_POS; COMPLEX_NORM_CX;
+ REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`]);;
--- /dev/null
+(* ========================================================================= *)
+(* Examples of using the Grobner basis procedure. *)
+(* ========================================================================= *)
+
+time COMPLEX_ARITH
+ `!a b c.
+ (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (a * y pow 2 + b * y + c = Cx(&0)) /\
+ ~(x = y)
+ ==> (a * (x + y) + b = Cx(&0))`;;
+
+time COMPLEX_ARITH
+ `!a b c.
+ (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (Cx(&2) * a * y pow 2 + Cx(&2) * b * y + Cx(&2) * c = Cx(&0)) /\
+ ~(x = y)
+ ==> (a * (x + y) + b = Cx(&0))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Another example. *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `~((y_1 = Cx(&2) * y_3) /\
+ (y_2 = Cx(&2) * y_4) /\
+ (y_1 * y_3 = y_2 * y_4) /\
+ ((y_1 pow 2 - y_2 pow 2) * z = Cx(&1)))`;;
+
+time COMPLEX_ARITH
+ `!y_1 y_2 y_3 y_4.
+ (y_1 = Cx(&2) * y_3) /\
+ (y_2 = Cx(&2) * y_4) /\
+ (y_1 * y_3 = y_2 * y_4)
+ ==> (y_1 pow 2 = y_2 pow 2)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Angle at centre vs. angle at circumference. *)
+(* Formulation from "Real quantifier elimination in practice" paper. *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `~((c pow 2 = a pow 2 + b pow 2) /\
+ (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\
+ (y0 * t1 = a + x0) /\
+ (y0 * t2 = a - x0) /\
+ ((Cx(&1) - t1 * t2) * t = t1 + t2) /\
+ (u * (b * t - a) = Cx(&1)) /\
+ (v1 * a + v2 * x0 + v3 * y0 = Cx(&1)))`;;
+
+time COMPLEX_ARITH
+ `(c pow 2 = a pow 2 + b pow 2) /\
+ (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\
+ (y0 * t1 = a + x0) /\
+ (y0 * t2 = a - x0) /\
+ ((Cx(&1) - t1 * t2) * t = t1 + t2) /\
+ (~(a = Cx(&0)) \/ ~(x0 = Cx(&0)) \/ ~(y0 = Cx(&0)))
+ ==> (b * t = a)`;;
+
+time COMPLEX_ARITH
+ `(c pow 2 = a pow 2 + b pow 2) /\
+ (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\
+ (y0 * t1 = a + x0) /\
+ (y0 * t2 = a - x0) /\
+ ((Cx(&1) - t1 * t2) * t = t1 + t2) /\
+ (~(a = Cx(&0)) /\ ~(x0 = Cx(&0)) /\ ~(y0 = Cx(&0)))
+ ==> (b * t = a)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Another example (note we rule out points 1, 2 or 3 coinciding). *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `((x1 - x0) pow 2 + (y1 - y0) pow 2 =
+ (x2 - x0) pow 2 + (y2 - y0) pow 2) /\
+ ((x2 - x0) pow 2 + (y2 - y0) pow 2 =
+ (x3 - x0) pow 2 + (y3 - y0) pow 2) /\
+ ((x1 - x0') pow 2 + (y1 - y0') pow 2 =
+ (x2 - x0') pow 2 + (y2 - y0') pow 2) /\
+ ((x2 - x0') pow 2 + (y2 - y0') pow 2 =
+ (x3 - x0') pow 2 + (y3 - y0') pow 2) /\
+ (a12 * (x1 - x2) + b12 * (y1 - y2) = Cx(&1)) /\
+ (a13 * (x1 - x3) + b13 * (y1 - y3) = Cx(&1)) /\
+ (a23 * (x2 - x3) + b23 * (y2 - y3) = Cx(&1)) /\
+ ~((x1 - x0) pow 2 + (y1 - y0) pow 2 = Cx(&0))
+ ==> (x0' = x0) /\ (y0' = y0)`;;
+
+time COMPLEX_ARITH
+ `~(((x1 - x0) pow 2 + (y1 - y0) pow 2 =
+ (x2 - x0) pow 2 + (y2 - y0) pow 2) /\
+ ((x2 - x0) pow 2 + (y2 - y0) pow 2 =
+ (x3 - x0) pow 2 + (y3 - y0) pow 2) /\
+ ((x1 - x0') pow 2 + (y1 - y0') pow 2 =
+ (x2 - x0') pow 2 + (y2 - y0') pow 2) /\
+ ((x2 - x0') pow 2 + (y2 - y0') pow 2 =
+ (x3 - x0') pow 2 + (y3 - y0') pow 2) /\
+ (a12 * (x1 - x2) + b12 * (y1 - y2) = Cx(&1)) /\
+ (a13 * (x1 - x3) + b13 * (y1 - y3) = Cx(&1)) /\
+ (a23 * (x2 - x3) + b23 * (y2 - y3) = Cx(&1)) /\
+ (z * (x0' - x0) = Cx(&1)) /\
+ (z' * (y0' - y0) = Cx(&1)) /\
+ (z'' * ((x1 - x0) pow 2 + (y1 - y0) pow 2) = Cx(&1)) /\
+ (z''' * ((x1 - x09) pow 2 + (y1 - y09) pow 2) = Cx(&1)))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* These are pure algebraic simplification. *)
+(* ------------------------------------------------------------------------- *)
+
+let LAGRANGE_4 = time COMPLEX_ARITH
+ `(((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) *
+ ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2))) =
+ ((((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) +
+ (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) +
+ (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) +
+ (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2))`;;
+
+let LAGRANGE_8 = time COMPLEX_ARITH
+ `((p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) *
+ (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2)) =
+ ((p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1* w2) pow 2 +
+ (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1* v2) pow 2 +
+ (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1* u2) pow 2 +
+ (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1* t2) pow 2 +
+ (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1* s2) pow 2 +
+ (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1* r2) pow 2 +
+ (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1* q2) pow 2 +
+ (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1* p2) pow 2)`;;
+
+let LIOUVILLE = time COMPLEX_ARITH
+ `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) =
+ (Cx(&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 +
+ (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) +
+ Cx(&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 +
+ (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;;
+
+let FLECK = time COMPLEX_ARITH
+ `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 3) =
+ (Cx(&1 / &60) * ((x1 + x2 + x3) pow 6 + (x1 + x2 - x3) pow 6 +
+ (x1 - x2 + x3) pow 6 + (x1 - x2 - x3) pow 6 +
+ (x1 + x2 + x4) pow 6 + (x1 + x2 - x4) pow 6 +
+ (x1 - x2 + x4) pow 6 + (x1 - x2 - x4) pow 6 +
+ (x1 + x3 + x4) pow 6 + (x1 + x3 - x4) pow 6 +
+ (x1 - x3 + x4) pow 6 + (x1 - x3 - x4) pow 6 +
+ (x2 + x3 + x4) pow 6 + (x2 + x3 - x4) pow 6 +
+ (x2 - x3 + x4) pow 6 + (x2 - x3 - x4) pow 6) +
+ Cx(&1 / &30) * ((x1 + x2) pow 6 + (x1 - x2) pow 6 +
+ (x1 + x3) pow 6 + (x1 - x3) pow 6 +
+ (x1 + x4) pow 6 + (x1 - x4) pow 6 +
+ (x2 + x3) pow 6 + (x2 - x3) pow 6 +
+ (x2 + x4) pow 6 + (x2 - x4) pow 6 +
+ (x3 + x4) pow 6 + (x3 - x4) pow 6) +
+ Cx(&3 / &5) * (x1 pow 6 + x2 pow 6 + x3 pow 6 + x4 pow 6))`;;
+
+let HURWITZ = time COMPLEX_ARITH
+ `!x1 x2 x3 x4.
+ (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 4 =
+ Cx(&1 / &840) * ((x1 + x2 + x3 + x4) pow 8 +
+ (x1 + x2 + x3 - x4) pow 8 +
+ (x1 + x2 - x3 + x4) pow 8 +
+ (x1 + x2 - x3 - x4) pow 8 +
+ (x1 - x2 + x3 + x4) pow 8 +
+ (x1 - x2 + x3 - x4) pow 8 +
+ (x1 - x2 - x3 + x4) pow 8 +
+ (x1 - x2 - x3 - x4) pow 8) +
+ Cx(&1 / &5040) * ((Cx(&2) * x1 + x2 + x3) pow 8 +
+ (Cx(&2) * x1 + x2 - x3) pow 8 +
+ (Cx(&2) * x1 - x2 + x3) pow 8 +
+ (Cx(&2) * x1 - x2 - x3) pow 8 +
+ (Cx(&2) * x1 + x2 + x4) pow 8 +
+ (Cx(&2) * x1 + x2 - x4) pow 8 +
+ (Cx(&2) * x1 - x2 + x4) pow 8 +
+ (Cx(&2) * x1 - x2 - x4) pow 8 +
+ (Cx(&2) * x1 + x3 + x4) pow 8 +
+ (Cx(&2) * x1 + x3 - x4) pow 8 +
+ (Cx(&2) * x1 - x3 + x4) pow 8 +
+ (Cx(&2) * x1 - x3 - x4) pow 8 +
+ (Cx(&2) * x2 + x3 + x4) pow 8 +
+ (Cx(&2) * x2 + x3 - x4) pow 8 +
+ (Cx(&2) * x2 - x3 + x4) pow 8 +
+ (Cx(&2) * x2 - x3 - x4) pow 8 +
+ (x1 + Cx(&2) * x2 + x3) pow 8 +
+ (x1 + Cx(&2) * x2 - x3) pow 8 +
+ (x1 - Cx(&2) * x2 + x3) pow 8 +
+ (x1 - Cx(&2) * x2 - x3) pow 8 +
+ (x1 + Cx(&2) * x2 + x4) pow 8 +
+ (x1 + Cx(&2) * x2 - x4) pow 8 +
+ (x1 - Cx(&2) * x2 + x4) pow 8 +
+ (x1 - Cx(&2) * x2 - x4) pow 8 +
+ (x1 + Cx(&2) * x3 + x4) pow 8 +
+ (x1 + Cx(&2) * x3 - x4) pow 8 +
+ (x1 - Cx(&2) * x3 + x4) pow 8 +
+ (x1 - Cx(&2) * x3 - x4) pow 8 +
+ (x2 + Cx(&2) * x3 + x4) pow 8 +
+ (x2 + Cx(&2) * x3 - x4) pow 8 +
+ (x2 - Cx(&2) * x3 + x4) pow 8 +
+ (x2 - Cx(&2) * x3 - x4) pow 8 +
+ (x1 + x2 + Cx(&2) * x3) pow 8 +
+ (x1 + x2 - Cx(&2) * x3) pow 8 +
+ (x1 - x2 + Cx(&2) * x3) pow 8 +
+ (x1 - x2 - Cx(&2) * x3) pow 8 +
+ (x1 + x2 + Cx(&2) * x4) pow 8 +
+ (x1 + x2 - Cx(&2) * x4) pow 8 +
+ (x1 - x2 + Cx(&2) * x4) pow 8 +
+ (x1 - x2 - Cx(&2) * x4) pow 8 +
+ (x1 + x3 + Cx(&2) * x4) pow 8 +
+ (x1 + x3 - Cx(&2) * x4) pow 8 +
+ (x1 - x3 + Cx(&2) * x4) pow 8 +
+ (x1 - x3 - Cx(&2) * x4) pow 8 +
+ (x2 + x3 + Cx(&2) * x4) pow 8 +
+ (x2 + x3 - Cx(&2) * x4) pow 8 +
+ (x2 - x3 + Cx(&2) * x4) pow 8 +
+ (x2 - x3 - Cx(&2) * x4) pow 8) +
+ Cx(&1 / &84) * ((x1 + x2) pow 8 + (x1 - x2) pow 8 +
+ (x1 + x3) pow 8 + (x1 - x3) pow 8 +
+ (x1 + x4) pow 8 + (x1 - x4) pow 8 +
+ (x2 + x3) pow 8 + (x2 - x3) pow 8 +
+ (x2 + x4) pow 8 + (x2 - x4) pow 8 +
+ (x3 + x4) pow 8 + (x3 - x4) pow 8) +
+ Cx(&1 / &840) * ((Cx(&2) * x1) pow 8 + (Cx(&2) * x2) pow 8 +
+ (Cx(&2) * x3) pow 8 + (Cx(&2) * x4) pow 8)`;;
+
+let SCHUR = time COMPLEX_ARITH
+ `Cx(&22680) * (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 5 =
+ Cx(&9) * ((Cx(&2) * x1) pow 10 +
+ (Cx(&2) * x2) pow 10 +
+ (Cx(&2) * x3) pow 10 +
+ (Cx(&2) * x4) pow 10) +
+ Cx(&180) * ((x1 + x2) pow 10 + (x1 - x2) pow 10 +
+ (x1 + x3) pow 10 + (x1 - x3) pow 10 +
+ (x1 + x4) pow 10 + (x1 - x4) pow 10 +
+ (x2 + x3) pow 10 + (x2 - x3) pow 10 +
+ (x2 + x4) pow 10 + (x2 - x4) pow 10 +
+ (x3 + x4) pow 10 + (x3 - x4) pow 10) +
+ ((Cx(&2) * x1 + x2 + x3) pow 10 +
+ (Cx(&2) * x1 + x2 - x3) pow 10 +
+ (Cx(&2) * x1 - x2 + x3) pow 10 +
+ (Cx(&2) * x1 - x2 - x3) pow 10 +
+ (Cx(&2) * x1 + x2 + x4) pow 10 +
+ (Cx(&2) * x1 + x2 - x4) pow 10 +
+ (Cx(&2) * x1 - x2 + x4) pow 10 +
+ (Cx(&2) * x1 - x2 - x4) pow 10 +
+ (Cx(&2) * x1 + x3 + x4) pow 10 +
+ (Cx(&2) * x1 + x3 - x4) pow 10 +
+ (Cx(&2) * x1 - x3 + x4) pow 10 +
+ (Cx(&2) * x1 - x3 - x4) pow 10 +
+ (Cx(&2) * x2 + x3 + x4) pow 10 +
+ (Cx(&2) * x2 + x3 - x4) pow 10 +
+ (Cx(&2) * x2 - x3 + x4) pow 10 +
+ (Cx(&2) * x2 - x3 - x4) pow 10 +
+ (x1 + Cx(&2) * x2 + x3) pow 10 +
+ (x1 + Cx(&2) * x2 - x3) pow 10 +
+ (x1 - Cx(&2) * x2 + x3) pow 10 +
+ (x1 - Cx(&2) * x2 - x3) pow 10 +
+ (x1 + Cx(&2) * x2 + x4) pow 10 +
+ (x1 + Cx(&2) * x2 - x4) pow 10 +
+ (x1 - Cx(&2) * x2 + x4) pow 10 +
+ (x1 - Cx(&2) * x2 - x4) pow 10 +
+ (x1 + Cx(&2) * x3 + x4) pow 10 +
+ (x1 + Cx(&2) * x3 - x4) pow 10 +
+ (x1 - Cx(&2) * x3 + x4) pow 10 +
+ (x1 - Cx(&2) * x3 - x4) pow 10 +
+ (x2 + Cx(&2) * x3 + x4) pow 10 +
+ (x2 + Cx(&2) * x3 - x4) pow 10 +
+ (x2 - Cx(&2) * x3 + x4) pow 10 +
+ (x2 - Cx(&2) * x3 - x4) pow 10 +
+ (x1 + x2 + Cx(&2) * x3) pow 10 +
+ (x1 + x2 - Cx(&2) * x3) pow 10 +
+ (x1 - x2 + Cx(&2) * x3) pow 10 +
+ (x1 - x2 - Cx(&2) * x3) pow 10 +
+ (x1 + x2 + Cx(&2) * x4) pow 10 +
+ (x1 + x2 - Cx(&2) * x4) pow 10 +
+ (x1 - x2 + Cx(&2) * x4) pow 10 +
+ (x1 - x2 - Cx(&2) * x4) pow 10 +
+ (x1 + x3 + Cx(&2) * x4) pow 10 +
+ (x1 + x3 - Cx(&2) * x4) pow 10 +
+ (x1 - x3 + Cx(&2) * x4) pow 10 +
+ (x1 - x3 - Cx(&2) * x4) pow 10 +
+ (x2 + x3 + Cx(&2) * x4) pow 10 +
+ (x2 + x3 - Cx(&2) * x4) pow 10 +
+ (x2 - x3 + Cx(&2) * x4) pow 10 +
+ (x2 - x3 - Cx(&2) * x4) pow 10) +
+ Cx(&9) * ((x1 + x2 + x3 + x4) pow 10 +
+ (x1 + x2 + x3 - x4) pow 10 +
+ (x1 + x2 - x3 + x4) pow 10 +
+ (x1 + x2 - x3 - x4) pow 10 +
+ (x1 - x2 + x3 + x4) pow 10 +
+ (x1 - x2 + x3 - x4) pow 10 +
+ (x1 - x2 - x3 + x4) pow 10 +
+ (x1 - x2 - x3 - x4) pow 10)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Intersection of diagonals of a parallelogram is their midpoint. *)
+(* Kapur "...Dixon resultants, Groebner Bases, and Characteristic Sets", 3.1 *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `(x1 = u3) /\
+ (x1 * (u2 - u1) = x2 * u3) /\
+ (x4 * (x2 - u1) = x1 * (x3 - u1)) /\
+ (x3 * u3 = x4 * u2) /\
+ ~(u1 = Cx(&0)) /\
+ ~(u3 = Cx(&0))
+ ==> (x3 pow 2 + x4 pow 2 = (u2 - x3) pow 2 + (u3 - x4) pow 2)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Chou's formulation of same property. *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `(u1 * x1 - u1 * u3 = Cx(&0)) /\
+ (u3 * x2 - (u2 - u1) * x1 = Cx(&0)) /\
+ (x1 * x4 - (x2 - u1) * x3 - u1 * x1 = Cx(&0)) /\
+ (u3 * x4 - u2 * x3 = Cx(&0)) /\
+ ~(u1 = Cx(&0)) /\
+ ~(u3 = Cx(&0))
+ ==> (Cx(&2) * u2 * x4 + Cx(&2) * u3 * x3 - u3 pow 2 - u2 pow 2 = Cx(&0))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Perpendicular lines property; from Kapur's earlier paper. *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `(y1 * y3 + x1 * x3 = Cx(&0)) /\
+ (y3 * (y2 - y3) + (x2 - x3) * x3 = Cx(&0)) /\
+ ~(x3 = Cx(&0)) /\
+ ~(y3 = Cx(&0))
+ ==> (y1 * (x2 - x3) = x1 * (y2 - y3))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Simson's theorem (Chou, p7). *)
+(* ------------------------------------------------------------------------- *)
+
+time COMPLEX_ARITH
+ `(Cx(&2) * u2 * x2 + Cx(&2) * u3 * x1 - u3 pow 2 - u2 pow 2 = Cx(&0)) /\
+ (Cx(&2) * u1 * x2 - u1 pow 2 = Cx(&0)) /\
+ (--(x3 pow 2) + Cx(&2) * x2 * x3 + Cx(&2) * u4 * x1 - u4 pow 2 = Cx(&0)) /\
+ (u3 * x5 + (--u2 + u1) * x4 - u1 * u3 = Cx(&0)) /\
+ ((u2 - u1) * x5 + u3 * x4 + (--u2 + u1) * x3 - u3 * u4 = Cx(&0)) /\
+ (u3 * x7 - u2 * x6 = Cx(&0)) /\
+ (u2 * x7 + u3 * x6 - u2 * x3 - u3 * u4 = Cx(&0)) /\
+ ~(Cx(&4) * u1 * u3 = Cx(&0)) /\
+ ~(Cx(&2) * u1 = Cx(&0)) /\
+ ~(--(u3 pow 2) - u2 pow 2 + Cx(&2) * u1 * u2 - u1 pow 2 = Cx(&0)) /\
+ ~(u3 = Cx(&0)) /\
+ ~(--(u3 pow 2) - u2 pow 2 = Cx(&0)) /\
+ ~(u2 = Cx(&0))
+ ==> (x4 * x7 + (--x5 + x3) * x6 - x3 * x4 = Cx(&0))`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Determinants from Coq convex hull paper (some require reals or order). *)
+(* ------------------------------------------------------------------------- *)
+
+let det3 = new_definition
+ `det3(a11,a12,a13,
+ a21,a22,a23,
+ a31,a32,a33) =
+ a11 * (a22 * a33 - a32 * a23) -
+ a12 * (a21 * a33 - a31 * a23) +
+ a13 * (a21 * a32 - a31 * a22)`;;
+
+let DET_TRANSPOSE = prove
+ (`det3(a1,b1,c1,a2,b2,c2,a3,b3,c3) =
+ det3(a1,a2,a3,b1,b2,b3,c1,c2,c3)`,
+ REWRITE_TAC[det3] THEN CONV_TAC(time COMPLEX_ARITH));;
+
+let sdet3 = new_definition
+ `sdet3(p,q,r) = det3(FST p,SND p,Cx(&1),
+ FST q,SND q,Cx(&1),
+ FST r,SND r,Cx(&1))`;;
+
+let SDET3_PERMUTE_1 = prove
+ (`sdet3(p,q,r) = sdet3(q,r,p)`,
+ REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));;
+
+let SDET3_PERMUTE_2 = prove
+ (`sdet3(p,q,r) = --(sdet3(p,r,q))`,
+ REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));;
+
+let SDET_SUM = prove
+ (`sdet3(p,q,r) - sdet3(t,q,r) - sdet3(p,t,r) - sdet3(p,q,t) = Cx(&0)`,
+ REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));;
+
+let SDET_CRAMER = prove
+ (`sdet3(s,t,q) * sdet3(t,p,r) = sdet3(t,q,r) * sdet3(s,t,p) +
+ sdet3(t,p,q) * sdet3(s,t,r)`,
+ REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));;
+
+let SDET_NZ = prove
+ (`!p q r. ~(sdet3(p,q,r) = Cx(&0))
+ ==> ~(p = q) /\ ~(q = r) /\ ~(r = p)`,
+ REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ; sdet3; det3] THEN
+ CONV_TAC(time COMPLEX_ARITH));;
+
+let SDET_LINCOMB = prove
+ (`(FST p * sdet3(i,j,k) =
+ FST i * sdet3(j,k,p) + FST j * sdet3(k,i,p) + FST k * sdet3(i,j,p)) /\
+ (SND p * sdet3(i,j,k) =
+ SND i * sdet3(j,k,p) + SND j * sdet3(k,i,p) + SND k * sdet3(i,j,p))`,
+ REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));;
+
+(***** I'm not sure if this is true; there must be some
+ sufficient degenerate conditions....
+
+let th = prove
+ (`~(~(xp pow 2 + yp pow 2 = Cx(&0)) /\
+ ~(xq pow 2 + yq pow 2 = Cx(&0)) /\
+ ~(xr pow 2 + yr pow 2 = Cx(&0)) /\
+ (det3(xp,yp,Cx(&1),
+ xq,yq,Cx(&1),
+ xr,yr,Cx(&1)) = Cx(&0)) /\
+ (det3(yp,xp pow 2 + yp pow 2,Cx(&1),
+ yq,xq pow 2 + yq pow 2,Cx(&1),
+ yr,xr pow 2 + yr pow 2,Cx(&1)) = Cx(&0)) /\
+ (det3(xp,xp pow 2 + yp pow 2,Cx(&1),
+ xq,xq pow 2 + yq pow 2,Cx(&1),
+ xr,xr pow 2 + yr pow 2,Cx(&1)) = Cx(&0)))`,
+ REWRITE_TAC[det3] THEN
+ CONV_TAC(time COMPLEX_ARITH));;
+
+***************)
+
+(* ------------------------------------------------------------------------- *)
+(* Some geometry concepts (just "axiomatic" in this file). *)
+(* ------------------------------------------------------------------------- *)
+
+prioritize_real();;
+
+let collinear = new_definition
+ `collinear (a:real#real) b c <=>
+ ((FST a - FST b) * (SND b - SND c) =
+ (SND a - SND b) * (FST b - FST c))`;;
+
+let parallel = new_definition
+ `parallel (a,b) (c,d) <=>
+ ((FST a - FST b) * (SND c - SND d) = (SND a - SND b) * (FST c - FST d))`;;
+
+let perpendicular = new_definition
+ `perpendicular (a,b) (c,d) <=>
+ ((FST a - FST b) * (FST c - FST d) + (SND a - SND b) * (SND c - SND d) =
+ &0)`;;
+
+let oncircle_with_diagonal = new_definition
+ `oncircle_with_diagonal a (b,c) = perpendicular (b,a) (c,a)`;;
+
+let length = new_definition
+ `length (a,b) = sqrt((FST a - FST b) pow 2 + (SND a - SND b) pow 2)`;;
+
+let lengths_eq = new_definition
+ `lengths_eq (a,b) (c,d) <=>
+ ((FST a - FST b) pow 2 + (SND a - SND b) pow 2 =
+ (FST c - FST d) pow 2 + (SND c - SND d) pow 2)`;;
+
+let is_midpoint = new_definition
+ `is_midpoint b (a,c) <=>
+ (&2 * FST b = FST a + FST c) /\
+ (&2 * SND b = SND a + SND c)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Chou isn't explicit about this. *)
+(* ------------------------------------------------------------------------- *)
+
+let is_intersection = new_definition
+ `is_intersection p (a,b) (c,d) <=>
+ collinear a p b /\ collinear c p d`;;
+
+(* ------------------------------------------------------------------------- *)
+(* This is used in some degenerate conditions. See Chou, p18. *)
+(* ------------------------------------------------------------------------- *)
+
+let isotropic = new_definition
+ `isotropic (a,b) = perpendicular (a,b) (a,b)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* This increases degree, but sometimes makes complex assertion useful. *)
+(* ------------------------------------------------------------------------- *)
+
+let distinctpairs = new_definition
+ `distinctpairs pprs <=>
+ ~(ITLIST (\(a,b) pr. ((FST a - FST b) pow 2 + (SND a - SND b) pow 2) * pr)
+ pprs (&1) = &0)`;;
+
+(* ------------------------------------------------------------------------- *)
+(* Simple tactic to remove defined concepts and expand coordinates. *)
+(* ------------------------------------------------------------------------- *)
+
+let (EXPAND_COORDS_TAC:tactic) =
+ let complex2_ty = `:real#real` in
+ fun (asl,w) ->
+ (let fvs = filter (fun v -> type_of v = complex2_ty) (frees w) in
+ MAP_EVERY (fun v -> SPEC_TAC(v,v)) fvs THEN
+ GEN_REWRITE_TAC DEPTH_CONV [FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN
+ REPEAT GEN_TAC) (asl,w);;
+
+let PAIR_BETA_THM = prove
+ (`(\(x,y). P x y) (a,b) = P a b`,
+ CONV_TAC(LAND_CONV GEN_BETA_CONV) THEN REFL_TAC);;
+
+let GEOM_TAC =
+ EXPAND_COORDS_TAC THEN
+ GEN_REWRITE_TAC TOP_DEPTH_CONV
+ [collinear; parallel; perpendicular; oncircle_with_diagonal;
+ length; lengths_eq; is_midpoint; is_intersection; distinctpairs;
+ isotropic; ITLIST; PAIR_BETA_THM; BETA_THM; PAIR_EQ; FST; SND];;
+
+(* ------------------------------------------------------------------------- *)
+(* Centroid (Chou, example 142). *)
+(* ------------------------------------------------------------------------- *)
+
+let CENTROID = time prove
+ (`is_midpoint d (b,c) /\
+ is_midpoint e (a,c) /\
+ is_midpoint f (a,b) /\
+ is_intersection m (b,e) (a,d)
+ ==> collinear c f m`,
+ GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);;
+
+(* ------------------------------------------------------------------------- *)
+(* Gauss's theorem (Chou, example 15). *)
+(* ------------------------------------------------------------------------- *)
+
+let GAUSS = time prove
+ (`collinear x a0 a3 /\
+ collinear x a1 a2 /\
+ collinear y a2 a3 /\
+ collinear y a1 a0 /\
+ is_midpoint m1 (a1,a3) /\
+ is_midpoint m2 (a0,a2) /\
+ is_midpoint m3 (x,y)
+ ==> collinear m1 m2 m3`,
+ GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);;
+
+(* ------------------------------------------------------------------------- *)
+(* Simson's theorem (Chou, example 288). *)
+(* ------------------------------------------------------------------------- *)
+
+(**** These are all hideously slow. At least the first one works.
+ I haven't had the patience to try the rest.
+
+let SIMSON = time prove
+ (`lengths_eq (O,a) (O,b) /\
+ lengths_eq (O,a) (O,c) /\
+ lengths_eq (d,O) (O,a) /\
+ perpendicular (e,d) (b,c) /\
+ collinear e b c /\
+ perpendicular (f,d) (a,c) /\
+ collinear f a c /\
+ perpendicular (g,d) (a,b) /\
+ collinear g a b /\
+ ~(collinear a c b) /\
+ ~(lengths_eq (a,b) (a,a)) /\
+ ~(lengths_eq (a,c) (a,a)) /\
+ ~(lengths_eq (b,c) (a,a))
+ ==> collinear e f g`,
+ GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);;
+
+let SIMSON = time prove
+ (`lengths_eq (O,a) (O,b) /\
+ lengths_eq (O,a) (O,c) /\
+ lengths_eq (d,O) (O,a) /\
+ perpendicular (e,d) (b,c) /\
+ collinear e b c /\
+ perpendicular (f,d) (a,c) /\
+ collinear f a c /\
+ perpendicular (g,d) (a,b) /\
+ collinear g a b /\
+ ~(a = b) /\ ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d) /\ ~(c = d)
+ ==> collinear e f g`,
+ GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);;
+
+let SIMSON = time prove
+ (`lengths_eq (O,a) (O,b) /\
+ lengths_eq (O,a) (O,c) /\
+ lengths_eq (d,O) (O,a) /\
+ perpendicular (e,d) (b,c) /\
+ collinear e b c /\
+ perpendicular (f,d) (a,c) /\
+ collinear f a c /\
+ perpendicular (g,d) (a,b) /\
+ collinear g a b /\
+ ~(collinear a c b) /\
+ ~(isotropic (a,b)) /\
+ ~(isotropic (a,c)) /\
+ ~(isotropic (b,c)) /\
+ ~(isotropic (a,d)) /\
+ ~(isotropic (b,d)) /\
+ ~(isotropic (c,d))
+ ==> collinear e f g`,
+ GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);;
+
+****************)
--- /dev/null
+(* ========================================================================= *)
+(* Naive quantifier elimination for complex numbers. *)
+(* ========================================================================= *)
+
+needs "Complex/fundamental.ml";;
+
+let NULLSTELLENSATZ_LEMMA = prove
+ (`!n p q. (!x. (poly p x = Cx(&0)) ==> (poly q x = Cx(&0))) /\
+ (degree p = n) /\ ~(n = 0)
+ ==> p divides (q exp n)`,
+ MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
+ MAP_EVERY X_GEN_TAC [`p:complex list`; `q:complex list`] THEN
+ ASM_CASES_TAC `?a. poly p a = Cx(&0)` THENL
+ [ALL_TAC;
+ DISCH_THEN(K ALL_TAC) THEN
+ FIRST_ASSUM(MP_TAC o MATCH_MP
+ (ONCE_REWRITE_RULE[TAUT `a ==> b <=> ~b ==> ~a`]
+ FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT)) THEN
+ REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+ MAP_EVERY X_GEN_TAC [`k:complex`; `zeros:complex list`] THEN
+ STRIP_TAC THEN REWRITE_TAC[divides] THEN
+ EXISTS_TAC `[inv(k)] ** q exp n` THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN X_GEN_TAC `z:complex` THEN
+ ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_RINV; COMPLEX_MUL_LID;
+ poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; POLY_0]] THEN
+ FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` MP_TAC) THEN
+ DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
+ GEN_REWRITE_TAC LAND_CONV [ORDER_ROOT] THEN
+ ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL
+ [ASM_SIMP_TAC[DEGREE_ZERO] THEN MESON_TAC[]; ALL_TAC] THEN
+ STRIP_TAC THEN STRIP_TAC THEN
+ MP_TAC(SPECL [`p:complex list`; `a:complex`; `order a p`] ORDER) THEN
+ ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_DEGREE) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
+ FIRST_ASSUM(MP_TAC o SPEC `a:complex`) THEN
+ REWRITE_TAC[ASSUME `poly p a = Cx(&0)`] THEN
+ REWRITE_TAC[POLY_LINEAR_DIVIDES] THEN
+ ASM_CASES_TAC `q:complex list = []` THENL
+ [DISCH_TAC THEN MATCH_MP_TAC POLY_DIVIDES_ZERO THEN
+ UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN
+ INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp] THEN DISCH_TAC THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_LZERO; poly];
+ ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(X_CHOOSE_THEN `r:complex list` SUBST_ALL_TAC) THEN
+ UNDISCH_TAC `[--a; Cx (&1)] exp (order a p) divides p` THEN
+ GEN_REWRITE_TAC LAND_CONV [divides] THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN
+ SUBGOAL_THEN `~(poly s = poly [])` ASSUME_TAC THENL
+ [DISCH_TAC THEN UNDISCH_TAC `~(poly p = poly [])` THEN
+ ASM_REWRITE_TAC[POLY_ENTIRE]; ALL_TAC] THEN
+ ASM_CASES_TAC `degree s = 0` THENL
+ [SUBGOAL_THEN `?k. ~(k = Cx(&0)) /\ (poly s = poly [k])` MP_TAC THENL
+ [EXISTS_TAC `LAST(normalize s)` THEN
+ ASM_SIMP_TAC[NORMAL_NORMALIZE; GSYM POLY_NORMALIZE_ZERO] THEN
+ GEN_REWRITE_TAC LAND_CONV [GSYM POLY_NORMALIZE] THEN
+ UNDISCH_TAC `degree s = 0` THEN
+ FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
+ [POLY_NORMALIZE_ZERO]) THEN
+ REWRITE_TAC[degree] THEN
+ SPEC_TAC(`normalize s`,`s:complex list`) THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL] THEN
+ REWRITE_TAC[LENGTH; PRE; poly; LAST] THEN
+ COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+ ASM_REWRITE_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `k:complex` STRIP_ASSUME_TAC) THEN
+ REWRITE_TAC[divides] THEN
+ EXISTS_TAC `[inv(k)] ** [--a; Cx (&1)] exp (n - order a p) ** r exp n` THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_EXP; COMPLEX_POW_MUL] THEN
+ X_GEN_TAC `z:complex` THEN
+ ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC
+ `(a * b) * c * d * e = ((d * a) * (c * b)) * e`] THEN
+ AP_THM_TAC THEN AP_TERM_TAC THEN
+ REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[SUB_ADD] THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN
+ ASM_SIMP_TAC[COMPLEX_MUL_LINV; COMPLEX_MUL_RID]; ALL_TAC] THEN
+ SUBGOAL_THEN `degree s < n` ASSUME_TAC THENL
+ [EXPAND_TAC "n" THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN
+ REWRITE_TAC[LINEAR_POW_MUL_DEGREE] THEN
+ ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(order a p = 0)` THEN ARITH_TAC;
+ ALL_TAC] THEN
+ FIRST_X_ASSUM(MP_TAC o SPEC `degree s`) THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(MP_TAC o SPECL [`s:complex list`; `r:complex list`]) THEN
+ ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
+ [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
+ UNDISCH_TAC
+ `!x. (poly p x = Cx(&0)) ==> (poly([--a; Cx (&1)] ** r) x = Cx(&0))` THEN
+ DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
+ ASM_REWRITE_TAC[POLY_MUL; COMPLEX_MUL_RID] THEN
+ REWRITE_TAC[COMPLEX_ENTIRE] THEN
+ MATCH_MP_TAC(TAUT `~a ==> (a \/ b ==> b)`) THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ REWRITE_TAC[SIMPLE_COMPLEX_ARITH
+ `(--a + z * Cx(&1) = Cx(&0)) <=> (z = a)`] THEN
+ DISCH_THEN SUBST_ALL_TAC THEN
+ UNDISCH_TAC `poly s a = Cx (&0)` THEN
+ ASM_REWRITE_TAC[POLY_LINEAR_DIVIDES; DE_MORGAN_THM] THEN
+ CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `u:complex list` SUBST_ALL_TAC) THEN
+ UNDISCH_TAC `~([--a; Cx (&1)] exp SUC (order a p) divides p)` THEN
+ REWRITE_TAC[divides] THEN
+ EXISTS_TAC `u:complex list` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[POLY_MUL; poly_exp; COMPLEX_MUL_AC; FUN_EQ_THM];
+ ALL_TAC] THEN
+ REWRITE_TAC[divides] THEN
+ DISCH_THEN(X_CHOOSE_THEN `u:complex list` ASSUME_TAC) THEN
+ EXISTS_TAC
+ `u ** [--a; Cx(&1)] exp (n - order a p) ** r exp (n - degree s)` THEN
+ ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_EXP; COMPLEX_POW_MUL] THEN
+ X_GEN_TAC `z:complex` THEN
+ ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC
+ `(ap * s) * u * anp * rns = (anp * ap) * rns * s * u`] THEN
+ REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN
+ ASM_SIMP_TAC[SUB_ADD] THEN AP_TERM_TAC THEN
+ GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM POLY_MUL] THEN
+ SUBST1_TAC(SYM(ASSUME `poly (r exp degree s) = poly (s ** u)`)) THEN
+ REWRITE_TAC[POLY_EXP; GSYM COMPLEX_POW_ADD] THEN
+ ASM_SIMP_TAC[SUB_ADD; LT_IMP_LE]);;
+
+let NULLSTELLENSATZ_UNIVARIATE = prove
+ (`!p q. (!x. (poly p x = Cx(&0)) ==> (poly q x = Cx(&0))) <=>
+ p divides (q exp (degree p)) \/
+ ((poly p = poly []) /\ (poly q = poly []))`,
+ REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THENL
+ [ASM_REWRITE_TAC[poly] THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN
+ REWRITE_TAC[degree; normalize; LENGTH; ARITH; poly_exp] THEN
+ ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL; poly;
+ COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN
+ ASM_CASES_TAC `degree p = 0` THENL
+ [ALL_TAC;
+ MP_TAC(SPECL [`degree p`; `p:complex list`; `q:complex list`]
+ NULLSTELLENSATZ_LEMMA) THEN
+ ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EQ_TAC THEN ASM_REWRITE_TAC[] THEN
+ DISCH_THEN(fun th ->
+ X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MP_TAC th) THEN
+ ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL] THEN
+ DISCH_THEN(CHOOSE_THEN (MP_TAC o SPEC `z:complex`)) THEN
+ ASM_REWRITE_TAC[POLY_EXP; COMPLEX_MUL_LZERO; COMPLEX_POW_EQ_0]] THEN
+ ASM_REWRITE_TAC[poly_exp] THEN
+ SUBGOAL_THEN `?k. ~(k = Cx(&0)) /\ (poly p = poly [k])` MP_TAC THENL
+ [SUBST1_TAC(SYM(SPEC `p:complex list` POLY_NORMALIZE)) THEN
+ EXISTS_TAC `LAST(normalize p)` THEN
+ ASM_SIMP_TAC[NORMAL_NORMALIZE; GSYM POLY_NORMALIZE_ZERO] THEN
+ GEN_REWRITE_TAC LAND_CONV [GSYM POLY_NORMALIZE] THEN
+ UNDISCH_TAC `degree p = 0` THEN
+ FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
+ [POLY_NORMALIZE_ZERO]) THEN
+ REWRITE_TAC[degree] THEN
+ SPEC_TAC(`normalize p`,`p:complex list`) THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL] THEN
+ REWRITE_TAC[LENGTH; PRE; poly; LAST] THEN
+ SIMP_TAC[LENGTH_EQ_NIL; POLY_NORMALIZE]; ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `k:complex` STRIP_ASSUME_TAC) THEN
+ ASM_REWRITE_TAC[divides; poly; FUN_EQ_THM; POLY_MUL] THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ EXISTS_TAC `[inv(k)]` THEN
+ ASM_REWRITE_TAC[divides; poly; FUN_EQ_THM; POLY_MUL] THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ ASM_SIMP_TAC[COMPLEX_MUL_RINV]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Useful lemma I should have proved ages ago. *)
+(* ------------------------------------------------------------------------- *)
+
+let CONSTANT_DEGREE = prove
+ (`!p. constant(poly p) <=> (degree p = 0)`,
+ GEN_TAC THEN REWRITE_TAC[constant] THEN EQ_TAC THENL
+ [DISCH_THEN(ASSUME_TAC o GSYM o SPEC `Cx(&0)`) THEN
+ SUBGOAL_THEN `degree [poly p (Cx(&0))] = 0` MP_TAC THENL
+ [REWRITE_TAC[degree; normalize] THEN
+ COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN CONV_TAC NUM_REDUCE_CONV;
+ ALL_TAC] THEN
+ MATCH_MP_TAC(ARITH_RULE `(x = y) ==> (x = 0) ==> (y = 0)`) THEN
+ MATCH_MP_TAC DEGREE_WELLDEF THEN
+ REWRITE_TAC[FUN_EQ_THM; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ FIRST_ASSUM(ACCEPT_TAC o GSYM);
+ ONCE_REWRITE_TAC[GSYM POLY_NORMALIZE] THEN REWRITE_TAC[degree] THEN
+ SPEC_TAC(`normalize p`,`l:complex list`) THEN
+ MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[poly] THEN
+ SIMP_TAC[LENGTH; PRE; LENGTH_EQ_NIL; poly; COMPLEX_MUL_RZERO]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* It would be nicer to prove this without using algebraic closure... *)
+(* ------------------------------------------------------------------------- *)
+
+let DIVIDES_DEGREE_LEMMA = prove
+ (`!n p q. (degree(p) = n)
+ ==> n <= degree(p ** q) \/ (poly(p ** q) = poly [])`,
+ INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN REPEAT STRIP_TAC THEN
+ MP_TAC(SPEC `p:complex list` FUNDAMENTAL_THEOREM_OF_ALGEBRA) THEN
+ ASM_REWRITE_TAC[CONSTANT_DEGREE; NOT_SUC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `a:complex` MP_TAC) THEN
+ GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN
+ DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL
+ [REWRITE_TAC[POLY_MUL; poly; COMPLEX_MUL_LZERO; FUN_EQ_THM];
+ ALL_TAC] THEN
+ DISCH_THEN(X_CHOOSE_THEN `r:complex list` SUBST_ALL_TAC) THEN
+ SUBGOAL_THEN `poly (([--a; Cx (&1)] ** r) ** q) =
+ poly ([--a; Cx (&1)] ** (r ** q))`
+ ASSUME_TAC THENL
+ [REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN
+ ASM_REWRITE_TAC[] THEN
+ MP_TAC(SPECL [`r ** q`; `--a`] LINEAR_MUL_DEGREE) THEN
+ ASM_CASES_TAC `poly (r ** q) = poly []` THENL
+ [REWRITE_TAC[FUN_EQ_THM] THEN
+ ONCE_REWRITE_TAC[POLY_MUL] THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO]; ALL_TAC] THEN
+ ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
+ SUBGOAL_THEN `n <= degree(r ** q) \/ (poly(r ** q) = poly [])` MP_TAC THENL
+ [ALL_TAC;
+ REWRITE_TAC[ARITH_RULE `SUC n <= m + 1 <=> n <= m`] THEN
+ STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[FUN_EQ_THM] THEN
+ ONCE_REWRITE_TAC[POLY_MUL] THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO]] THEN
+ MP_TAC(SPECL [`r:complex list`; `--a`] LINEAR_MUL_DEGREE) THEN ANTS_TAC THENL
+ [UNDISCH_TAC `~(poly (r ** q) = poly [])` THEN
+ REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN
+ SIMP_TAC[poly; FUN_EQ_THM; POLY_MUL; COMPLEX_ENTIRE]; ALL_TAC] THEN
+ DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
+ UNDISCH_TAC `degree r + 1 = SUC n` THEN ARITH_TAC);;
+
+let DIVIDES_DEGREE = prove
+ (`!p q. p divides q ==> degree(p) <= degree(q) \/ (poly q = poly [])`,
+ REPEAT GEN_TAC THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN
+ X_GEN_TAC `r:complex list` THEN DISCH_TAC THEN
+ FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN ASM_REWRITE_TAC[] THEN
+ ASM_MESON_TAC[DIVIDES_DEGREE_LEMMA]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Arithmetic operations on multivariate polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let MPOLY_BASE_CONV =
+ let pth_0 = prove
+ (`Cx(&0) = poly [] x`,
+ REWRITE_TAC[poly])
+ and pth_1 = prove
+ (`c = poly [c] x`,
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID])
+ and pth_var = prove
+ (`x = poly [Cx(&0); Cx(&1)] x`,
+ REWRITE_TAC[poly; COMPLEX_ADD_LID; COMPLEX_MUL_RZERO] THEN
+ REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_RID])
+ and zero_tm = `Cx(&0)`
+ and c_tm = `c:complex`
+ and x_tm = `x:complex` in
+ let rec MPOLY_BASE_CONV avs tm =
+ if avs = [] then REFL tm
+ else if tm = zero_tm then INST [hd avs,x_tm] pth_0
+ else if tm = hd avs then
+ let th1 = INST [tm,x_tm] pth_var in
+ let th2 =
+ (LAND_CONV
+ (COMB2_CONV (RAND_CONV (MPOLY_BASE_CONV (tl avs)))
+ (LAND_CONV (MPOLY_BASE_CONV (tl avs)))))
+ (rand(concl th1)) in
+ TRANS th1 th2
+ else
+ let th1 = MPOLY_BASE_CONV (tl avs) tm in
+ let th2 = INST [hd avs,x_tm; rand(concl th1),c_tm] pth_1 in
+ TRANS th1 th2 in
+ MPOLY_BASE_CONV;;
+
+let MPOLY_NORM_CONV =
+ let pth_0 = prove
+ (`poly [Cx(&0)] x = poly [] x`,
+ REWRITE_TAC[poly; COMPLEX_ADD_RID; COMPLEX_MUL_RZERO])
+ and pth_1 = prove
+ (`poly [poly [] y] x = poly [] x`,
+ REWRITE_TAC[poly; COMPLEX_ADD_RID; COMPLEX_MUL_RZERO]) in
+ let conv_fwd = REWR_CONV(CONJUNCT2 poly)
+ and conv_bck = REWR_CONV(GSYM(CONJUNCT2 poly))
+ and conv_0 = GEN_REWRITE_CONV I [pth_0]
+ and conv_1 = GEN_REWRITE_CONV I [pth_1] in
+ let rec NORM0_CONV tm =
+ (conv_0 ORELSEC
+ (conv_fwd THENC RAND_CONV(RAND_CONV NORM0_CONV) THENC conv_bck THENC
+ TRY_CONV NORM0_CONV)) tm
+ and NORM1_CONV tm =
+ (conv_1 ORELSEC
+ (conv_fwd THENC RAND_CONV(RAND_CONV NORM1_CONV) THENC conv_bck THENC
+ TRY_CONV NORM1_CONV)) tm in
+ fun avs -> TRY_CONV(if avs = [] then NORM0_CONV else NORM1_CONV);;
+
+let MPOLY_ADD_CONV,MPOLY_TADD_CONV =
+ let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES))
+ and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)]
+ and add_conv = REWR_CONV(GSYM POLY_ADD) in
+ let rec MPOLY_ADD_CONV avs tm =
+ if avs = [] then COMPLEX_RAT_ADD_CONV tm else
+ (add_conv THENC LAND_CONV(MPOLY_TADD_CONV avs) THENC
+ MPOLY_NORM_CONV (tl avs)) tm
+ and MPOLY_TADD_CONV avs tm =
+ (add_conv0 ORELSEC
+ (add_conv1 THENC
+ LAND_CONV (MPOLY_ADD_CONV (tl avs)) THENC
+ RAND_CONV (MPOLY_TADD_CONV avs))) tm in
+ MPOLY_ADD_CONV,MPOLY_TADD_CONV;;
+
+let MPOLY_CMUL_CONV,MPOLY_TCMUL_CONV,MPOLY_MUL_CONV,MPOLY_TMUL_CONV =
+ let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul]
+ and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul]
+ and cmul_conv = REWR_CONV(GSYM POLY_CMUL)
+ and mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES]
+ and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)]
+ and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)]
+ and mul_conv = REWR_CONV(GSYM POLY_MUL) in
+ let rec MPOLY_CMUL_CONV avs tm =
+ (cmul_conv THENC LAND_CONV(MPOLY_TCMUL_CONV avs)) tm
+ and MPOLY_TCMUL_CONV avs tm =
+ (cmul_conv0 ORELSEC
+ (cmul_conv1 THENC
+ LAND_CONV (MPOLY_MUL_CONV (tl avs)) THENC
+ RAND_CONV (MPOLY_TCMUL_CONV avs))) tm
+ and MPOLY_MUL_CONV avs tm =
+ if avs = [] then COMPLEX_RAT_MUL_CONV tm else
+ (mul_conv THENC LAND_CONV(MPOLY_TMUL_CONV avs)) tm
+ and MPOLY_TMUL_CONV avs tm =
+ (mul_conv0 ORELSEC
+ (mul_conv1 THENC MPOLY_TCMUL_CONV avs) ORELSEC
+ (mul_conv2 THENC
+ COMB2_CONV (RAND_CONV(MPOLY_TCMUL_CONV avs))
+ (COMB2_CONV (RAND_CONV(MPOLY_BASE_CONV (tl avs)))
+ (MPOLY_TMUL_CONV avs)) THENC
+ MPOLY_TADD_CONV avs)) tm in
+ MPOLY_CMUL_CONV,MPOLY_TCMUL_CONV,MPOLY_MUL_CONV,MPOLY_TMUL_CONV;;
+
+let MPOLY_SUB_CONV =
+ let pth = prove
+ (`(poly p x - poly q x) = (poly p x + Cx(--(&1)) * poly q x)`,
+ SIMPLE_COMPLEX_ARITH_TAC) in
+ let APPLY_PTH_CONV = REWR_CONV pth in
+ fun avs ->
+ APPLY_PTH_CONV THENC
+ RAND_CONV(LAND_CONV (MPOLY_BASE_CONV (tl avs)) THENC
+ MPOLY_CMUL_CONV avs) THENC
+ MPOLY_ADD_CONV avs;;
+
+let MPOLY_POW_CONV =
+ let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 complex_pow]
+ and cnv_1 = GEN_REWRITE_CONV I [CONJUNCT2 complex_pow] in
+ let rec MPOLY_POW_CONV avs tm =
+ try (cnv_0 THENC MPOLY_BASE_CONV avs) tm with Failure _ ->
+ (RAND_CONV num_CONV THENC
+ cnv_1 THENC (RAND_CONV (MPOLY_POW_CONV avs)) THENC
+ MPOLY_MUL_CONV avs) tm in
+ MPOLY_POW_CONV;;
+
+(* ------------------------------------------------------------------------- *)
+(* Recursive conversion to polynomial form. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLYNATE_CONV =
+ let ELIM_SUB_CONV = REWR_CONV
+ (SIMPLE_COMPLEX_ARITH `x - y = x + Cx(--(&1)) * y`)
+ and ELIM_NEG_CONV = REWR_CONV
+ (SIMPLE_COMPLEX_ARITH `--x = Cx(--(&1)) * x`)
+ and ELIM_POW_0_CONV = GEN_REWRITE_CONV I [CONJUNCT1 complex_pow]
+ and ELIM_POW_1_CONV =
+ RAND_CONV num_CONV THENC GEN_REWRITE_CONV I [CONJUNCT2 complex_pow] in
+ let rec ELIM_POW_CONV tm =
+ (ELIM_POW_0_CONV ORELSEC (ELIM_POW_1_CONV THENC RAND_CONV ELIM_POW_CONV))
+ tm in
+ let polynet = itlist (uncurry net_of_conv)
+ [`x pow n`,(fun cnv avs -> LAND_CONV (cnv avs) THENC MPOLY_POW_CONV avs);
+ `x * y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_MUL_CONV avs);
+ `x + y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_ADD_CONV avs);
+ `x - y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_SUB_CONV avs);
+ `--x`,(fun cnv avs -> ELIM_NEG_CONV THENC (cnv avs))]
+ empty_net in
+ let rec POLYNATE_CONV avs tm =
+ try snd(hd(lookup tm polynet)) POLYNATE_CONV avs tm
+ with Failure _ -> MPOLY_BASE_CONV avs tm in
+ POLYNATE_CONV;;
+
+(* ------------------------------------------------------------------------- *)
+(* Cancellation conversion. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_PAD_RULE =
+ let pth = prove
+ (`(poly p x = Cx(&0)) ==> (poly (CONS (Cx(&0)) p) x = Cx(&0))`,
+ SIMP_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID]) in
+ let MATCH_pth = MATCH_MP pth in
+ fun avs th ->
+ let th1 = MATCH_pth th in
+ CONV_RULE(funpow 3 LAND_CONV (MPOLY_BASE_CONV (tl avs))) th1;;
+
+let POLY_CANCEL_EQ_CONV =
+ let pth_1 = prove
+ (`(p = Cx(&0)) /\ ~(a = Cx(&0))
+ ==> !q b. (q = Cx(&0)) <=> (a * q - b * p = Cx(&0))`,
+ SIMP_TAC[COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO; COMPLEX_ENTIRE]) in
+ let MATCH_CANCEL_THM = MATCH_MP pth_1 in
+ let rec POLY_CANCEL_EQ_CONV avs n ath eth tm =
+ let m = length(dest_list(lhand(lhand tm))) in
+ if m < n then REFL tm else
+ let th1 = funpow (m - n) (POLY_PAD_RULE avs) eth in
+ let th2 = MATCH_CANCEL_THM (CONJ th1 ath) in
+ let th3 = SPECL [lhs tm; last(dest_list(lhand(lhs tm)))] th2 in
+ let th4 = CONV_RULE(RAND_CONV(LAND_CONV
+ (BINOP_CONV(MPOLY_CMUL_CONV avs)))) th3 in
+ let th5 = CONV_RULE(RAND_CONV(LAND_CONV (MPOLY_SUB_CONV avs))) th4 in
+ TRANS th5 (POLY_CANCEL_EQ_CONV avs n ath eth (rand(concl th5))) in
+ POLY_CANCEL_EQ_CONV;;
+
+let RESOLVE_EQ_RAW =
+ let pth = prove
+ (`(poly [] x = Cx(&0)) /\
+ (poly [c] x = c)`,
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in
+ let REWRITE_pth = GEN_REWRITE_CONV LAND_CONV [pth] in
+ let rec RESOLVE_EQ asm tm =
+ try EQT_INTRO(find (fun th -> concl th = tm) asm) with Failure _ ->
+ let tm' = mk_neg tm in
+ try EQF_INTRO(find (fun th -> concl th = tm') asm) with Failure _ ->
+ try let th1 = REWRITE_pth tm in
+ TRANS th1 (RESOLVE_EQ asm (rand(concl th1)))
+ with Failure _ -> COMPLEX_RAT_EQ_CONV tm in
+ RESOLVE_EQ;;
+
+let RESOLVE_EQ asm tm =
+ let th = RESOLVE_EQ_RAW asm tm in
+ try EQF_ELIM th with Failure _ -> EQT_ELIM th;;
+
+let RESOLVE_EQ_THEN =
+ let MATCH_pth = MATCH_MP
+ (TAUT `(p ==> (q <=> q1)) /\ (~p ==> (q <=> q2))
+ ==> (q <=> (p /\ q1 \/ ~p /\ q2))`) in
+ fun asm tm yfn nfn ->
+ try let th = RESOLVE_EQ asm tm in
+ if is_neg(concl th) then nfn (th::asm) th else yfn (th::asm) th
+ with Failure _ ->
+ let tm' = mk_neg tm in
+ let yth = DISCH tm (yfn (ASSUME tm :: asm) (ASSUME tm))
+ and nth = DISCH tm' (nfn (ASSUME tm' :: asm) (ASSUME tm')) in
+ MATCH_pth (CONJ yth nth);;
+
+let POLY_CANCEL_ENE_CONV avs n ath eth tm =
+ if is_neg tm then RAND_CONV(POLY_CANCEL_EQ_CONV avs n ath eth) tm
+ else POLY_CANCEL_EQ_CONV avs n ath eth tm;;
+
+let RESOLVE_NE =
+ let NEGATE_NEGATE_RULE = GEN_REWRITE_RULE I [TAUT `p <=> (~p <=> F)`] in
+ fun asm tm ->
+ try let th = RESOLVE_EQ asm (rand tm) in
+ if is_neg(concl th) then EQT_INTRO th
+ else NEGATE_NEGATE_RULE th
+ with Failure _ -> REFL tm;;
+
+(* ------------------------------------------------------------------------- *)
+(* Conversion for division of polynomials. *)
+(* ------------------------------------------------------------------------- *)
+
+let LAST_CONV = GEN_REWRITE_CONV REPEATC [LAST_CLAUSES];;
+
+let LENGTH_CONV =
+ let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 LENGTH]
+ and cnv_1 = GEN_REWRITE_CONV I [CONJUNCT2 LENGTH] in
+ let rec LENGTH_CONV tm =
+ try cnv_0 tm with Failure _ ->
+ (cnv_1 THENC RAND_CONV LENGTH_CONV THENC NUM_SUC_CONV) tm in
+ LENGTH_CONV;;
+
+let EXPAND_EX_BETA_CONV =
+ let pth = prove(`EX P [c] = P c`,REWRITE_TAC[EX]) in
+ let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 EX]
+ and cnv_1 = GEN_REWRITE_CONV I [pth]
+ and cnv_2 = GEN_REWRITE_CONV I [CONJUNCT2 EX] in
+ let rec EXPAND_EX_BETA_CONV tm =
+ try (cnv_1 THENC BETA_CONV) tm with Failure _ -> try
+ (cnv_2 THENC COMB2_CONV (RAND_CONV BETA_CONV)
+ EXPAND_EX_BETA_CONV) tm
+ with Failure _ -> cnv_0 tm in
+ EXPAND_EX_BETA_CONV;;
+
+let POLY_DIVIDES_PAD_RULE =
+ let pth = prove
+ (`p divides q ==> p divides (CONS (Cx(&0)) q)`,
+ REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL; poly; COMPLEX_ADD_LID] THEN
+ DISCH_THEN(X_CHOOSE_THEN `r:complex list` ASSUME_TAC) THEN
+ EXISTS_TAC `[Cx(&0); Cx(&1)] ** r` THEN
+ ASM_REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_ADD_RID;
+ COMPLEX_MUL_RID; POLY_MUL] THEN
+ REWRITE_TAC[COMPLEX_MUL_AC]) in
+ let APPLY_pth = MATCH_MP pth in
+ fun avs n tm ->
+ funpow n
+ (CONV_RULE(RAND_CONV(LAND_CONV(MPOLY_BASE_CONV (tl avs)))) o APPLY_pth)
+ (SPEC tm POLY_DIVIDES_REFL);;
+
+let POLY_DIVIDES_PAD_CONST_RULE =
+ let pth = prove
+ (`p divides q ==> !a. p divides (a ## q)`,
+ REWRITE_TAC[FUN_EQ_THM; divides; POLY_CMUL; POLY_MUL] THEN
+ DISCH_THEN(X_CHOOSE_THEN `r:complex list` ASSUME_TAC) THEN
+ X_GEN_TAC `a:complex` THEN EXISTS_TAC `[a] ** r` THEN
+ ASM_REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC) in
+ let APPLY_pth = MATCH_MP pth in
+ fun avs n a tm ->
+ let th1 = POLY_DIVIDES_PAD_RULE avs n tm in
+ let th2 = SPEC a (APPLY_pth th1) in
+ CONV_RULE(RAND_CONV(MPOLY_TCMUL_CONV avs)) th2;;
+
+let EXPAND_EX_BETA_RESOLVE_CONV asm tm =
+ let th1 = EXPAND_EX_BETA_CONV tm in
+ let djs = disjuncts(rand(concl th1)) in
+ let th2 = end_itlist MK_DISJ (map (RESOLVE_NE asm) djs) in
+ TRANS th1 th2;;
+
+let POLY_DIVIDES_CONV =
+ let pth_0 = prove
+ (`LENGTH q < LENGTH p
+ ==> ~(LAST p = Cx(&0))
+ ==> (p divides q <=> ~(EX (\c. ~(c = Cx(&0))) q))`,
+ REPEAT STRIP_TAC THEN REWRITE_TAC[NOT_EX; GSYM POLY_ZERO] THEN EQ_TAC THENL
+ [ALL_TAC;
+ SIMP_TAC[divides; POLY_MUL; FUN_EQ_THM] THEN
+ DISCH_TAC THEN EXISTS_TAC `[]:complex list` THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO]] THEN
+ DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_DEGREE) THEN
+ MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> (a \/ b ==> b)`) THEN
+ DISCH_TAC THEN REWRITE_TAC[NOT_LE] THEN ASM_SIMP_TAC[NORMAL_DEGREE] THEN
+ REWRITE_TAC[degree] THEN
+ FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
+ `lq < lp ==> ~(lq = 0) /\ dq <= lq - 1 ==> dq < lp - 1`)) THEN
+ CONJ_TAC THENL [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN
+ MATCH_MP_TAC(ARITH_RULE `m <= n ==> PRE m <= n - 1`) THEN
+ REWRITE_TAC[LENGTH_NORMALIZE_LE]) in
+ let APPLY_pth0 = PART_MATCH (lhand o rand o rand) pth_0 in
+ let pth_1 = prove
+ (`~(a = Cx(&0))
+ ==> p divides p'
+ ==> (!x. a * poly q x - poly p' x = poly r x)
+ ==> (p divides q <=> p divides r)`,
+ DISCH_TAC THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN
+ X_GEN_TAC `t:complex list` THEN DISCH_THEN SUBST1_TAC THEN
+ REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN
+ DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN EQ_TAC THEN
+ DISCH_THEN(X_CHOOSE_THEN `s:complex list` MP_TAC) THENL
+ [DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
+ EXISTS_TAC `a ## s ++ --(Cx(&1)) ## t` THEN
+ REWRITE_TAC[POLY_MUL; POLY_ADD; POLY_CMUL] THEN
+ REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC;
+ REWRITE_TAC[POLY_MUL] THEN DISCH_TAC THEN
+ EXISTS_TAC `[inv(a)] ** (t ++ s)` THEN
+ X_GEN_TAC `z:complex` THEN
+ ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN
+ REWRITE_TAC[POLY_MUL; POLY_ADD; GSYM COMPLEX_MUL_ASSOC] THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
+ SUBGOAL_THEN `a * poly q z = (poly t z + poly s z) * poly p z`
+ MP_TAC THENL
+ [FIRST_ASSUM(MP_TAC o SPEC `z:complex`) THEN SIMPLE_COMPLEX_ARITH_TAC;
+ ALL_TAC] THEN
+ DISCH_THEN(MP_TAC o AP_TERM `( * ) (inv a)`) THEN
+ ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV; COMPLEX_MUL_LID]]) in
+ let MATCH_pth1 = MATCH_MP pth_1 in
+ let rec DIVIDE_STEP_CONV avs sfn n tm =
+ let m = length(dest_list(rand tm)) in
+ if m < n then REFL tm else
+ let th1 = POLY_DIVIDES_PAD_CONST_RULE avs (m - n)
+ (last(dest_list(rand tm))) (lhand tm) in
+ let th2 = MATCH_MP (sfn tm) th1 in
+ let av,bod = dest_forall(lhand(concl th2)) in
+ let tm1 = vsubst [hd avs,av] (lhand bod) in
+ let th3 = (LAND_CONV (MPOLY_CMUL_CONV avs) THENC MPOLY_SUB_CONV avs) tm1 in
+ let th4 = MATCH_MP th2 (GEN (hd avs) th3) in
+ TRANS th4 (DIVIDE_STEP_CONV avs sfn n (rand(concl th4))) in
+ let zero_tm = `Cx(&0)` in
+ fun asm avs tm ->
+ let ath = RESOLVE_EQ asm (mk_eq(last(dest_list(lhand tm)),zero_tm)) in
+ let sfn = PART_MATCH (lhand o rand o rand) (MATCH_pth1 ath)
+ and n = length(dest_list(lhand tm)) in
+ let th1 = DIVIDE_STEP_CONV avs sfn n tm in
+ let th2 = APPLY_pth0 (rand(concl th1)) in
+ let th3 = (BINOP_CONV LENGTH_CONV THENC NUM_LT_CONV) (lhand(concl th2)) in
+ let th4 = MP th2 (EQT_ELIM th3) in
+ let th5 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th4 in
+ let th6 = TRANS th1 (MP th5 ath) in
+ CONV_RULE(RAND_CONV(RAND_CONV(EXPAND_EX_BETA_RESOLVE_CONV asm))) th6;;
+
+(* ------------------------------------------------------------------------- *)
+(* Apply basic Nullstellensatz principle. *)
+(* ------------------------------------------------------------------------- *)
+
+let BASIC_QUELIM_CONV =
+ let pth_1 = prove
+ (`((?x. (poly p x = Cx(&0)) /\ ~(poly [] x = Cx(&0))) <=> F) /\
+ ((?x. ~(poly [] x = Cx(&0))) <=> F) /\
+ ((?x. ~(poly [c] x = Cx(&0))) <=> ~(c = Cx(&0))) /\
+ ((?x. (poly [] x = Cx(&0))) <=> T) /\
+ ((?x. (poly [c] x = Cx(&0))) <=> (c = Cx(&0)))`,
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in
+ let APPLY_pth1 = GEN_REWRITE_CONV I [pth_1] in
+ let pth_2 = prove
+ (`~(LAST(CONS a (CONS b p)) = Cx(&0))
+ ==> ((?x. poly (CONS a (CONS b p)) x = Cx(&0)) <=> T)`,
+ REPEAT STRIP_TAC THEN
+ MP_TAC(SPEC `CONS (a:complex) (CONS b p)`
+ FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT) THEN
+ REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
+ REWRITE_TAC[NOT_EXISTS_THM; CONS_11] THEN
+ REPEAT STRIP_TAC THEN
+ SUBGOAL_THEN `~(ALL (\c. c = Cx(&0)) (CONS b p))`
+ (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]) THEN
+ UNDISCH_TAC `~(LAST (CONS a (CONS b p)) = Cx (&0))` THEN
+ ONCE_REWRITE_TAC[LAST] THEN REWRITE_TAC[NOT_CONS_NIL] THEN
+ REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN
+ SPEC_TAC(`p:complex list`,`p:complex list`) THEN
+ LIST_INDUCT_TAC THEN ONCE_REWRITE_TAC[LAST] THEN
+ REWRITE_TAC[ALL; NOT_CONS_NIL] THEN
+ STRIP_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_imp o concl) THEN
+ REWRITE_TAC[LAST] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ALL]) in
+ let APPLY_pth2 = PART_MATCH (lhand o rand) pth_2 in
+ let pth_2b = prove
+ (`(?x. ~(poly p x = Cx(&0))) <=> EX (\c. ~(c = Cx(&0))) p`,
+ REWRITE_TAC[GSYM NOT_FORALL_THM] THEN
+ ONCE_REWRITE_TAC[TAUT `(~a <=> b) <=> (a <=> ~b)`] THEN
+ REWRITE_TAC[NOT_EX; GSYM POLY_ZERO; poly; FUN_EQ_THM]) in
+ let APPLY_pth2b = GEN_REWRITE_CONV I [pth_2b] in
+ let pth_3 = prove
+ (`~(LAST(CONS a p) = Cx(&0))
+ ==> ((?x. (poly (CONS a p) x = Cx(&0)) /\ ~(poly q x = Cx(&0))) <=>
+ ~((CONS a p) divides (q exp (LENGTH p))))`,
+ REPEAT STRIP_TAC THEN
+ MP_TAC(SPECL [`CONS (a:complex) p`; `q:complex list`]
+ NULLSTELLENSATZ_UNIVARIATE) THEN
+ ASM_SIMP_TAC[degree; NORMALIZE_EQ; LENGTH; PRE] THEN
+ SUBGOAL_THEN `~(poly (CONS a p) = poly [])`
+ (fun th -> REWRITE_TAC[th] THEN MESON_TAC[]) THEN
+ REWRITE_TAC[POLY_ZERO] THEN POP_ASSUM MP_TAC THEN
+ SPEC_TAC(`p:complex list`,`p:complex list`) THEN
+ REWRITE_TAC[LAST] THEN
+ LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; ALL; NOT_CONS_NIL] THEN
+ POP_ASSUM MP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ALL] THEN
+ CONV_TAC TAUT) in
+ let APPLY_pth3 = PART_MATCH (lhand o rand) pth_3 in
+ let POLY_EXP_DIVIDES_CONV =
+ let pth_4 = prove
+ (`(!x. (poly (q exp n) x = poly r x))
+ ==> (p divides (q exp n) <=> p divides r)`,
+ SIMP_TAC[divides; POLY_EXP; FUN_EQ_THM]) in
+ let APPLY_pth4 = MATCH_MP pth_4
+ and poly_tm = `poly`
+ and REWR_POLY_EXP_CONV = REWR_CONV POLY_EXP in
+ let POLY_EXP_DIVIDES_CONV avs tm =
+ let tm1 = mk_comb(mk_comb(poly_tm,rand tm),hd avs) in
+ let th1 = REWR_POLY_EXP_CONV tm1 in
+ let th2 = TRANS th1 (MPOLY_POW_CONV avs (rand(concl th1))) in
+ PART_MATCH lhand (APPLY_pth4 (GEN (hd avs) th2)) tm in
+ POLY_EXP_DIVIDES_CONV in
+ fun asm avs tm ->
+ try APPLY_pth1 tm with Failure _ ->
+ try let th1 = APPLY_pth2 tm in
+ let th2 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th1 in
+ let th3 = try MATCH_MP th2 (RESOLVE_EQ asm (rand(lhand(concl th2))))
+ with Failure _ -> failwith "Sanity failure (2a)" in
+ th3
+ with Failure _ -> try
+ let th1 = APPLY_pth2b tm in
+ TRANS th1 (EXPAND_EX_BETA_RESOLVE_CONV asm (rand(concl th1)))
+ with Failure _ ->
+ let th1 = APPLY_pth3 tm in
+ let th2 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th1 in
+ let th3 = try MATCH_MP th2 (RESOLVE_EQ asm (rand(lhand(concl th2))))
+ with Failure _ -> failwith "Sanity failure (2b)" in
+ let th4 = CONV_RULE (funpow 4 RAND_CONV LENGTH_CONV) th3 in
+ let th5 =
+ CONV_RULE(RAND_CONV(RAND_CONV(POLY_EXP_DIVIDES_CONV avs))) th4 in
+ CONV_RULE(RAND_CONV(RAND_CONV(POLY_DIVIDES_CONV asm avs))) th5;;
+
+(* ------------------------------------------------------------------------- *)
+(* Put into canonical form by multiplying inequalities. *)
+(* ------------------------------------------------------------------------- *)
+
+let POLY_NE_MULT_CONV =
+ let pth = prove
+ (`~(poly p x = Cx(&0)) /\ ~(poly q x = Cx(&0)) <=>
+ ~(poly p x * poly q x = Cx(&0))`,
+ REWRITE_TAC[COMPLEX_ENTIRE; DE_MORGAN_THM]) in
+ let APPLY_pth = REWR_CONV pth in
+ let rec POLY_NE_MULT_CONV avs tm =
+ if not(is_conj tm) then REFL tm else
+ let l,r = dest_conj tm in
+ let th1 = MK_COMB(AP_TERM (rator(rator tm)) (POLY_NE_MULT_CONV avs l),
+ POLY_NE_MULT_CONV avs r) in
+ let th2 = TRANS th1 (APPLY_pth (rand(concl th1))) in
+ CONV_RULE(RAND_CONV(RAND_CONV(LAND_CONV(MPOLY_MUL_CONV avs)))) th2 in
+ POLY_NE_MULT_CONV;;
+
+let CORE_QUELIM_CONV =
+ let CONJ_AC_RULE = AC CONJ_ACI in
+ let CORE_QUELIM_CONV asm avs tm =
+ let ev,bod = dest_exists tm in
+ let cjs = conjuncts bod in
+ let eqs,neqs = partition is_eq cjs in
+ if eqs = [] then
+ let th1 = MK_EXISTS ev (POLY_NE_MULT_CONV avs bod) in
+ TRANS th1 (BASIC_QUELIM_CONV asm avs (rand(concl th1)))
+ else if length eqs > 1 then failwith "CORE_QUELIM_CONV: Sanity failure"
+ else if neqs = [] then BASIC_QUELIM_CONV asm avs tm else
+ let tm1 = mk_conj(hd eqs,list_mk_conj neqs) in
+ let th1 = CONJ_AC_RULE(mk_eq(bod,tm1)) in
+ let th2 = CONV_RULE(funpow 2 RAND_CONV(POLY_NE_MULT_CONV avs)) th1 in
+ let th3 = MK_EXISTS ev th2 in
+ TRANS th3 (BASIC_QUELIM_CONV asm avs (rand(concl th3))) in
+ CORE_QUELIM_CONV;;
+
+(* ------------------------------------------------------------------------- *)
+(* Main elimination coversion (for a single quantifier). *)
+(* ------------------------------------------------------------------------- *)
+
+let RESOLVE_EQ_NE =
+ let DNE_RULE = GEN_REWRITE_RULE I
+ [TAUT `((p <=> T) <=> (~p <=> F)) /\ ((p <=> F) <=> (~p <=> T))`] in
+ fun asm tm ->
+ if is_neg tm then DNE_RULE(RESOLVE_EQ_RAW asm (rand tm))
+ else RESOLVE_EQ_RAW asm tm;;
+
+let COMPLEX_QUELIM_CONV =
+ let pth_0 = prove
+ (`((poly [] x = Cx(&0)) <=> T) /\
+ ((poly [] x = Cx(&0)) /\ p <=> p)`,
+ REWRITE_TAC[poly])
+ and pth_1 = prove
+ (`(~(poly [] x = Cx(&0)) <=> F) /\
+ (~(poly [] x = Cx(&0)) /\ p <=> F)`,
+ REWRITE_TAC[poly])
+ and pth_2 = prove
+ (`(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`,
+ CONV_TAC TAUT)
+ and zero_tm = `Cx(&0)`
+ and true_tm = `T` in
+ let ELIM_ZERO_RULE = GEN_REWRITE_RULE RAND_CONV [pth_0]
+ and ELIM_NONZERO_RULE = GEN_REWRITE_RULE RAND_CONV [pth_1]
+ and INCORP_ASSUM_THM = MATCH_MP pth_2
+ and CONJ_AC_RULE = AC CONJ_ACI in
+ let POLY_CONST_CONV =
+ let pth = prove
+ (`((poly [c] x = y) <=> (c = y)) /\
+ (~(poly [c] x = y) <=> ~(c = y))`,
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in
+ TRY_CONV(GEN_REWRITE_CONV I [pth]) in
+ let EXISTS_TRIV_CONV = REWR_CONV EXISTS_SIMP
+ and EXISTS_PUSH_CONV = REWR_CONV RIGHT_EXISTS_AND_THM
+ and AND_SIMP_CONV = GEN_REWRITE_CONV DEPTH_CONV
+ [TAUT `(p /\ F <=> F) /\ (p /\ T <=> p) /\
+ (F /\ p <=> F) /\ (T /\ p <=> p)`]
+ and RESOLVE_OR_CONST_CONV asm tm =
+ try RESOLVE_EQ_NE asm tm with Failure _ -> POLY_CONST_CONV tm
+ and false_tm = `F` in
+ let rec COMPLEX_QUELIM_CONV asm avs tm =
+ let ev,bod = dest_exists tm in
+ let cjs = conjuncts bod in
+ let cjs_set = setify cjs in
+ if length cjs_set < length cjs then
+ let th1 = CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs_set)) in
+ let th2 = MK_EXISTS ev th1 in
+ TRANS th2 (COMPLEX_QUELIM_CONV asm avs (rand(concl th2)))
+ else
+ let eqs,neqs = partition is_eq cjs in
+ let lens = map (length o dest_list o lhand o lhs) eqs
+ and nens = map (length o dest_list o lhand o lhs o rand) neqs in
+ try let zeq = el (index 0 lens) eqs in
+ if cjs = [zeq] then BASIC_QUELIM_CONV asm avs tm else
+ let cjs' = zeq::(subtract cjs [zeq]) in
+ let th1 = ELIM_ZERO_RULE(CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs'))) in
+ let th2 = MK_EXISTS ev th1 in
+ TRANS th2 (COMPLEX_QUELIM_CONV asm avs (rand(concl th2)))
+ with Failure _ -> try
+ let zne = el (index 0 nens) neqs in
+ if cjs = [zne] then BASIC_QUELIM_CONV asm avs tm else
+ let cjs' = zne::(subtract cjs [zne]) in
+ let th1 = ELIM_NONZERO_RULE
+ (CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs'))) in
+ CONV_RULE (RAND_CONV EXISTS_TRIV_CONV) (MK_EXISTS ev th1)
+ with Failure _ -> try
+ let ones = map snd (filter (fun (n,_) -> n = 1)
+ (zip lens eqs @ zip nens neqs)) in
+ if ones = [] then failwith "" else
+ let cjs' = subtract cjs ones in
+ if cjs' = [] then
+ let th1 = MK_EXISTS ev (SUBS_CONV(map POLY_CONST_CONV cjs) bod) in
+ TRANS th1 (EXISTS_TRIV_CONV (rand(concl th1)))
+ else
+ let tha = SUBS_CONV (map (RESOLVE_OR_CONST_CONV asm) ones)
+ (list_mk_conj ones) in
+ let thb = CONV_RULE (RAND_CONV AND_SIMP_CONV) tha in
+ if rand(concl thb) = false_tm then
+ let thc = MK_CONJ thb (REFL(list_mk_conj cjs')) in
+ let thd = CONV_RULE(RAND_CONV AND_SIMP_CONV) thc in
+ let the = CONJ_AC_RULE(mk_eq(bod,lhand(concl thd))) in
+ let thf = MK_EXISTS ev (TRANS the thd) in
+ CONV_RULE(RAND_CONV EXISTS_TRIV_CONV) thf
+ else
+ let thc = MK_CONJ thb (REFL(list_mk_conj cjs')) in
+ let thd = CONJ_AC_RULE(mk_eq(bod,lhand(concl thc))) in
+ let the = MK_EXISTS ev (TRANS thd thc) in
+ let th4 = TRANS the(EXISTS_PUSH_CONV(rand(concl the))) in
+ let tm4 = rand(concl th4) in
+ let th5 = COMPLEX_QUELIM_CONV asm avs (rand tm4) in
+ TRANS th4 (AP_TERM (rator tm4) th5)
+ with Failure _ ->
+ if eqs = [] or
+ (length eqs = 1 &
+ (let ceq = mk_eq(last(dest_list(lhand(lhs(hd eqs)))),zero_tm) in
+ try concl(RESOLVE_EQ asm ceq) = mk_neg ceq with Failure _ -> false) &
+ (let h = hd lens in forall (fun n -> n < h) nens))
+ then
+ CORE_QUELIM_CONV asm avs tm
+ else
+ let n = end_itlist min lens in
+ let eq = el (index n lens) eqs in
+ let pol = lhand(lhand eq) in
+ let atm = last(dest_list pol) in
+ let zeq = mk_eq(atm,zero_tm) in
+ RESOLVE_EQ_THEN asm zeq
+ (fun asm' yth ->
+ let th0 = TRANS yth (MPOLY_BASE_CONV (tl avs) zero_tm) in
+ let th1 =
+ GEN_REWRITE_CONV
+ (LAND_CONV o LAND_CONV o funpow (n - 1) RAND_CONV o LAND_CONV)
+ [th0] eq in
+ let th2 = LAND_CONV(MPOLY_NORM_CONV avs) (rand(concl th1)) in
+ let th3 = MK_EXISTS ev (SUBS_CONV[TRANS th1 th2] bod) in
+ TRANS th3 (COMPLEX_QUELIM_CONV asm' avs (rand(concl th3))))
+ (fun asm' nth ->
+ let oth = subtract cjs [eq] in
+ if oth = [] then COMPLEX_QUELIM_CONV asm' avs tm else
+ let eth = ASSUME eq in
+ let ths = map (POLY_CANCEL_ENE_CONV avs n nth eth) oth in
+ let th1 = DISCH eq (end_itlist MK_CONJ ths) in
+ let th2 = INCORP_ASSUM_THM th1 in
+ let th3 = TRANS (CONJ_AC_RULE(mk_eq(bod,lhand(concl th2)))) th2 in
+ let th4 = MK_EXISTS ev th3 in
+ TRANS th4 (COMPLEX_QUELIM_CONV asm' avs (rand(concl th4)))) in
+ fun asm avs -> time(COMPLEX_QUELIM_CONV asm avs);;
+
+(* ------------------------------------------------------------------------- *)
+(* NNF conversion doing "conditionals" ~(p /\ q \/ ~p /\ r) intelligently. *)
+(* ------------------------------------------------------------------------- *)
+
+let NNF_COND_CONV =
+ let NOT_EXISTS_UNIQUE_THM = prove
+ (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`,
+ REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN
+ REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in
+ let tauts =
+ [TAUT `~(~p) <=> p`;
+ TAUT `~(p /\ q) <=> ~p \/ ~q`;
+ TAUT `~(p \/ q) <=> ~p /\ ~q`;
+ TAUT `~(p ==> q) <=> p /\ ~q`;
+ TAUT `p ==> q <=> ~p \/ q`;
+ NOT_FORALL_THM;
+ NOT_EXISTS_THM;
+ EXISTS_UNIQUE_THM;
+ NOT_EXISTS_UNIQUE_THM;
+ TAUT `~(p <=> q) <=> (p /\ ~q) \/ (~p /\ q)`;
+ TAUT `(p <=> q) <=> (p /\ q) \/ (~p /\ ~q)`;
+ TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in
+ GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;;
+
+(* ------------------------------------------------------------------------- *)
+(* Overall procedure for multiple quantifiers in any first order formula. *)
+(* ------------------------------------------------------------------------- *)
+
+let FULL_COMPLEX_QUELIM_CONV =
+ let ELIM_FORALL_CONV =
+ let pth = prove(`(!x. P x) <=> ~(?x. ~(P x))`,MESON_TAC[]) in
+ REWR_CONV pth in
+ let ELIM_EQ_CONV =
+ let pth = SIMPLE_COMPLEX_ARITH `(x = y) <=> (x - y = Cx(&0))`
+ and zero_tm = `Cx(&0)` in
+ let REWR_pth = REWR_CONV pth in
+ fun avs tm ->
+ if rand tm = zero_tm then LAND_CONV(POLYNATE_CONV avs) tm
+ else (REWR_pth THENC LAND_CONV(POLYNATE_CONV avs)) tm in
+ let SIMP_DNF_CONV =
+ GEN_REWRITE_CONV TOP_DEPTH_CONV (basic_rewrites()) THENC
+ NNF_COND_CONV THENC DNF_CONV in
+ let DISTRIB_EXISTS_CONV = GEN_REWRITE_CONV I [EXISTS_OR_THM] in
+ let TRIV_EXISTS_CONV = GEN_REWRITE_CONV I [EXISTS_SIMP] in
+ let complex_ty = `:complex` in
+ let FINAL_SIMP_CONV =
+ GEN_REWRITE_CONV DEPTH_CONV [CX_INJ] THENC
+ REAL_RAT_REDUCE_CONV THENC
+ GEN_REWRITE_CONV TOP_DEPTH_CONV (basic_rewrites()) in
+ let rec FULL_COMPLEX_QUELIM_CONV avs tm =
+ if is_forall tm then
+ let th1 = ELIM_FORALL_CONV tm in
+ let th2 = FULL_COMPLEX_QUELIM_CONV avs (rand(concl th1)) in
+ TRANS th1 th2
+ else if is_neg tm then
+ AP_TERM (rator tm) (FULL_COMPLEX_QUELIM_CONV avs (rand tm))
+ else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then
+ let lop,r = dest_comb tm in
+ let op,l = dest_comb lop in
+ let thl = FULL_COMPLEX_QUELIM_CONV avs l
+ and thr = FULL_COMPLEX_QUELIM_CONV avs r in
+ MK_COMB(AP_TERM(rator(rator tm)) thl,thr)
+ else if is_exists tm then
+ let ev,bod = dest_exists tm in
+ let th0 = FULL_COMPLEX_QUELIM_CONV (ev::avs) bod in
+ let th1 = MK_EXISTS ev (CONV_RULE(RAND_CONV SIMP_DNF_CONV) th0) in
+ TRANS th1 (DISTRIB_AND_COMPLEX_QUELIM_CONV (ev::avs) (rand(concl th1)))
+ else if is_eq tm then
+ ELIM_EQ_CONV avs tm
+ else failwith "unexpected type of formula"
+ and DISTRIB_AND_COMPLEX_QUELIM_CONV avs tm =
+ try TRIV_EXISTS_CONV tm
+ with Failure _ -> try
+ (DISTRIB_EXISTS_CONV THENC
+ BINOP_CONV (DISTRIB_AND_COMPLEX_QUELIM_CONV avs)) tm
+ with Failure _ -> COMPLEX_QUELIM_CONV [] avs tm in
+ fun tm ->
+ let avs = filter (fun t -> type_of t = complex_ty) (frees tm) in
+ (FULL_COMPLEX_QUELIM_CONV avs THENC FINAL_SIMP_CONV) tm;;
--- /dev/null
+(* ========================================================================= *)
+(* Some examples of full complex quantifier elimination. *)
+(* ========================================================================= *)
+
+let th = time prove
+ (`!x y. (x pow 2 = Cx(&2)) /\ (y pow 2 = Cx(&3))
+ ==> ((x * y) pow 2 = Cx(&6))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`!x a. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0))
+ ==> (x pow 4 + Cx(&1) = Cx(&0))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`!a x. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0))
+ ==> (x pow 4 + Cx(&1) = Cx(&0))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`~(?a x y. (a pow 2 = Cx(&2)) /\
+ (x pow 2 + a * x + Cx(&1) = Cx(&0)) /\
+ (y * (x pow 4 + Cx(&1)) + Cx(&1) = Cx(&0)))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`!x. ?y. x pow 2 = y pow 3`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`!x y z a b. (a + b) * (x - y + z) - (a - b) * (x + y + z) =
+ Cx(&2) * (b * x + b * z - a * y)`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`!a b. ~(a = b) ==> ?x y. (y * x pow 2 = a) /\ (y * x pow 2 + x = b)`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (a * y pow 2 + b * y + c = Cx(&0)) /\
+ ~(x = y)
+ ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+let th = time prove
+ (`~(!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (a * y pow 2 + b * y + c = Cx(&0))
+ ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0)))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+(** geometric example from ``Algorithms for Computer Algebra'':
+ right triangle where perp. bisector of hypotenuse passes through the
+ right angle is isoseles.
+ **)
+
+let th = time prove
+ (`!y_1 y_2 y_3 y_4.
+ (y_1 = Cx(&2) * y_3) /\
+ (y_2 = Cx(&2) * y_4) /\
+ (y_1 * y_3 = y_2 * y_4)
+ ==> (y_1 pow 2 = y_2 pow 2)`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+(** geometric example: gradient condition for two lines to be non-parallel.
+ **)
+
+let th = time prove
+ (`!a1 b1 c1 a2 b2 c2.
+ ~(a1 * b2 = a2 * b1)
+ ==> ?x y. (a1 * x + b1 * y = c1) /\ (a2 * x + b2 * y = c2)`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+(*********** Apparently takes too long
+
+let th = time prove
+ (`!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (a * y pow 2 + b * y + c = Cx(&0)) /\
+ (!z. (a * z pow 2 + b * z + c = Cx(&0))
+ ==> (z = x) \/ (z = y))
+ ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+*************)
+
+(* ------------------------------------------------------------------------- *)
+(* Any three points determine a circle. Not true in complex number version! *)
+(* ------------------------------------------------------------------------- *)
+
+(******** And it takes a lot of memory!
+
+let th = time prove
+ (`~(!x1 y1 x2 y2 x3 y3.
+ ?x0 y0. ((x1 - x0) pow 2 + (y1 - y0) pow 2 =
+ (x2 - x0) pow 2 + (y2 - y0) pow 2) /\
+ ((x2 - x0) pow 2 + (y2 - y0) pow 2 =
+ (x3 - x0) pow 2 + (y3 - y0) pow 2))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+ **************)
+
+(* ------------------------------------------------------------------------- *)
+(* To show we don't need to consider only closed formulas. *)
+(* Can eliminate some, then deal with the rest manually and painfully. *)
+(* ------------------------------------------------------------------------- *)
+
+let th = time prove
+ (`(?x y. (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (a * y pow 2 + b * y + c = Cx(&0)) /\
+ ~(x = y)) <=>
+ (a = Cx(&0)) /\ (b = Cx(&0)) /\ (c = Cx(&0)) \/
+ ~(a = Cx(&0)) /\ ~(b pow 2 = Cx(&4) * a * c)`,
+ CONV_TAC(LAND_CONV FULL_COMPLEX_QUELIM_CONV) THEN
+ REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN
+ REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN
+ ASM_CASES_TAC `a = Cx(&0)` THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THENL
+ [ASM_CASES_TAC `b = Cx(&0)` THEN
+ ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO];
+ ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH
+ `b * b * c * Cx(--(&1)) + a * c * c * Cx(&4) =
+ c * (Cx(&4) * a * c - b * b)`] THEN
+ ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH
+ `b * b * b * Cx(--(&1)) + a * b * c * Cx (&4) =
+ b * (Cx(&4) * a * c - b * b)`] THEN
+ ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH
+ `b * b * Cx (&1) + a * c * Cx(--(&4)) =
+ Cx(--(&1)) * (Cx(&4) * a * c - b * b)`] THEN
+ REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_SUB_0; CX_INJ] THEN
+ CONV_TAC REAL_RAT_REDUCE_CONV THEN
+ ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN
+ ASM_CASES_TAC `c = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN
+ REWRITE_TAC[COMPLEX_POW_2; COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO] THEN
+ REWRITE_TAC[EQ_SYM_EQ]]);;
+
+(* ------------------------------------------------------------------------- *)
+(* Do the same thing directly. *)
+(* ------------------------------------------------------------------------- *)
+
+(**** This seems barely feasible
+
+let th = time prove
+ (`!a b c.
+ (?x y. (a * x pow 2 + b * x + c = Cx(&0)) /\
+ (a * y pow 2 + b * y + c = Cx(&0)) /\
+ ~(x = y)) <=>
+ (a = Cx(&0)) /\ (b = Cx(&0)) /\ (c = Cx(&0)) \/
+ ~(a = Cx(&0)) /\ ~(b pow 2 = Cx(&4) * a * c)`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+ ****)
+
+(* ------------------------------------------------------------------------- *)
+(* More ambitious: determine a unique circle. Also not true over complexes. *)
+(* (consider the points (k, k i) where i is the imaginary unit...) *)
+(* ------------------------------------------------------------------------- *)
+
+(********** Takes too long, I think, and too much memory too
+
+let th = prove
+ (`~(!x1 y1 x2 y2 x3 y3 x0 y0 x0' y0'.
+ ((x1 - x0) pow 2 + (y1 - y0) pow 2 =
+ (x2 - x0) pow 2 + (y2 - y0) pow 2) /\
+ ((x2 - x0) pow 2 + (y2 - y0) pow 2 =
+ (x3 - x0) pow 2 + (y3 - y0) pow 2) /\
+ ((x1 - x0') pow 2 + (y1 - y0') pow 2 =
+ (x2 - x0') pow 2 + (y2 - y0') pow 2) /\
+ ((x2 - x0') pow 2 + (y2 - y0') pow 2 =
+ (x3 - x0') pow 2 + (y3 - y0') pow 2)
+ ==> (x0 = x0') /\ (y0 = y0'))`,
+ CONV_TAC FULL_COMPLEX_QUELIM_CONV);;
+
+ *************)
+
+(* ------------------------------------------------------------------------- *)
+(* Side of a triangle in terms of its bisectors; Kapur survey 5.1. *)
+(* ------------------------------------------------------------------------- *)
+
+(*************
+let th = time FULL_COMPLEX_QUELIM_CONV
+ `?b c. (p1 = ai pow 2 * (b + c) pow 2 - c * b * (c + b - a) * (c + b + a)) /\
+ (p2 = ae pow 2 * (c - b) pow 2 - c * b * (a + b - c) * (a - b + a)) /\
+ (p3 = be pow 2 * (c - a) pow 2 - a * c * (a + b - c) * (c + b - a))`;;
+
+ *************)
--- /dev/null
+needs "Library/analysis.ml";; (* Basic real analysis *)
+needs "Library/transc.ml";; (* Real transcendental functions *)
+needs "Library/floor.ml";; (* Floor and frac functions *)
+
+needs "Complex/complexnumbers.ml";; (* Basic complex number defs *)
+needs "Complex/complex_transc.ml";; (* Complex transcendental functions *)
+
+needs "Complex/cpoly.ml";; (* Complex polynomials *)
+needs "Complex/fundamental.ml";; (* Fundamental theorem of algebra *)
+needs "Complex/quelim.ml";; (* Quantifier elimination algorithm *)
+needs "Complex/complex_grobner.ml";; (* Grobner bases with HOL proofs *)
+needs "Complex/complex_real.ml";; (* Special case of reals *)
+
+needs "Complex/quelim_examples.ml";; (* Examples of using quantifier elim *)
+needs "Complex/grobner_examples.ml";; (* Examples of using Grobner bases *)
git://colo12-c703.uibk.ac.at / Complex Analysis/.git / commitdiff