(* ========================================================================= *)
(* 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. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* 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`);;
(* ------------------------------------------------------------------------- *)
(* Imaginary unit (too inconvenient to use "i"!) *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Injection from reals. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Arithmetic operations. *)
(* ------------------------------------------------------------------------- *)
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_pow = new_recursive_definition num_RECURSION
`(x pow 0 = Cx(&1)) /\
(!n. x pow (SUC n) = x * x pow n)`;;
(* ------------------------------------------------------------------------- *)
(* Various handy rewrites. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* 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_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);;
(* ------------------------------------------------------------------------- *)
(* Homomorphic embedding properties for Cx mapping. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* A convenient lemma that we need a few times below. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Powers. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Norms (aka "moduli"). *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Complex conjugate. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* Conjugation is an automorphism. *)
(* ------------------------------------------------------------------------- *)
(* ------------------------------------------------------------------------- *)
(* 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_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_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. *)
(* ------------------------------------------------------------------------- *)