| 7998 |      1 | (*
 | 
|  |      2 |     Long division of polynomials
 | 
|  |      3 |     $Id$
 | 
|  |      4 |     Author: Clemens Ballarin, started 23 June 1999
 | 
|  |      5 | *)
 | 
|  |      6 | 
 | 
|  |      7 | Goal
 | 
|  |      8 |   "!!p::('a::ring up). \
 | 
|  |      9 | \    [| deg p <= deg r; deg q <= deg r; \
 | 
|  |     10 | \       coeff (deg r) p = - (coeff (deg r) q); deg r ~= 0 |] ==> \
 | 
|  |     11 | \    deg (p + q) < deg r";
 | 
|  |     12 | by (res_inst_tac [("j", "deg r - 1")] le_less_trans 1);
 | 
| 10962 |     13 | by (arith_tac 2);
 | 
| 7998 |     14 | by (rtac deg_aboveI 1);
 | 
|  |     15 | by (strip_tac 1);
 | 
|  |     16 | by (case_tac "deg r = m" 1);
 | 
|  |     17 | by (Clarify_tac 1);
 | 
|  |     18 | by (Asm_full_simp_tac 1);
 | 
|  |     19 | (* case "deg q ~= m" *)
 | 
| 10959 |     20 | by (subgoal_tac "deg p < m & deg q < m" 1);
 | 
| 7998 |     21 | by (asm_simp_tac (simpset() addsimps [deg_aboveD]) 1);
 | 
| 10959 |     22 | by (arith_tac 1);
 | 
| 7998 |     23 | qed "deg_lcoeff_cancel";
 | 
|  |     24 | 
 | 
|  |     25 | Goal
 | 
|  |     26 |   "!!p::('a::ring up). \
 | 
|  |     27 | \    [| deg p <= deg r; deg q <= deg r; \
 | 
|  |     28 | \       p ~= -q; coeff (deg r) p = - (coeff (deg r) q) |] ==> \
 | 
|  |     29 | \    deg (p + q) < deg r";
 | 
|  |     30 | by (rtac deg_lcoeff_cancel 1);
 | 
|  |     31 | by (REPEAT (atac 1));
 | 
|  |     32 | by (rtac classical 1);
 | 
|  |     33 | by (Clarify_tac 1);
 | 
|  |     34 | by (etac notE 1);
 | 
|  |     35 | by (res_inst_tac [("p", "p")] up_repr2D 1 THEN atac 1);
 | 
|  |     36 | by (res_inst_tac [("p", "q")] up_repr2D 1 THEN atac 1);
 | 
|  |     37 | by (rotate_tac ~1 1);
 | 
|  |     38 | by (asm_full_simp_tac (simpset() addsimps [smult_l_minus]) 1);
 | 
|  |     39 | qed "deg_lcoeff_cancel2";
 | 
|  |     40 | 
 | 
|  |     41 | Goal
 | 
|  |     42 |   "!!g::('a::ring up). g ~= <0> ==> \
 | 
|  |     43 | \    Ex (% (q, r, k). \
 | 
|  |     44 | \      (lcoeff g)^k *s f = q * g + r & (eucl_size r < eucl_size g))";
 | 
|  |     45 | by (res_inst_tac [("P", "%f. Ex (% (q, r, k). \
 | 
|  |     46 | \      (lcoeff g)^k *s f = q * g + r & (eucl_size r < eucl_size g))")]
 | 
|  |     47 |   wf_induct 1);
 | 
|  |     48 | (* TO DO: replace by measure_induct *)
 | 
|  |     49 | by (res_inst_tac [("f", "eucl_size")] wf_measure 1);
 | 
|  |     50 | by (case_tac "eucl_size x < eucl_size g" 1);
 | 
|  |     51 | by (res_inst_tac [("x", "(<0>, x, 0)")] exI 1);
 | 
|  |     52 | by (Asm_simp_tac 1);
 | 
|  |     53 | (* case "eucl_size x >= eucl_size g" *)
 | 
|  |     54 | by (dres_inst_tac [("x", "lcoeff g *s x -- (lcoeff x *s monom (deg x - deg g)) * g")] spec 1);
 | 
|  |     55 | by (etac impE 1);
 | 
|  |     56 | by (full_simp_tac (simpset() addsimps [inv_image_def, measure_def, lcoeff_def]) 1);
 | 
|  |     57 | by (case_tac "x = <0>" 1);
 | 
|  |     58 | by (rotate_tac ~1 1);
 | 
|  |     59 | by (asm_full_simp_tac (simpset() addsimps [eucl_size_def]) 1);
 | 
|  |     60 | (* case "x ~= <0> *)
 | 
|  |     61 | by (rotate_tac ~1 1);
 | 
|  |     62 | by (asm_full_simp_tac (simpset() addsimps [eucl_size_def]) 1);
 | 
| 8006 |     63 | by (Simp_tac 1);
 | 
| 7998 |     64 | by (rtac impI 1);
 | 
|  |     65 | by (rtac deg_lcoeff_cancel2 1);
 | 
|  |     66 |   (* replace by linear arithmetic??? *)
 | 
|  |     67 |   by (rtac le_trans 1);
 | 
|  |     68 |   by (rtac deg_smult_ring 1);
 | 
| 8006 |     69 |   by (Simp_tac 1);
 | 
| 7998 |     70 |   by (Simp_tac 1);
 | 
|  |     71 |   by (rtac le_trans 1);
 | 
|  |     72 |   by (rtac deg_mult_ring 1);
 | 
|  |     73 |   by (rtac le_trans 1);
 | 
|  |     74 |   by (rtac add_le_mono1 1);
 | 
|  |     75 |   by (rtac deg_smult_ring 1);
 | 
| 8006 |     76 |   by (asm_simp_tac (simpset() addsimps [leI]) 1);
 | 
| 8707 |     77 | by (Force_tac 1);
 | 
| 7998 |     78 | by (Simp_tac 1);
 | 
|  |     79 | by (res_inst_tac [("m", "deg x - deg g"), ("n", "deg x")] SUM_extend 1);
 | 
|  |     80 | by (Simp_tac 1);
 | 
|  |     81 | by (asm_simp_tac (simpset() addsimps [less_not_refl2 RS not_sym]) 1);
 | 
|  |     82 | by (res_inst_tac [("m", "deg x - deg g"), ("n", "deg x - deg g")]
 | 
|  |     83 |     SUM_extend_below 1);
 | 
|  |     84 | by (rtac le_refl 1);
 | 
|  |     85 | by (asm_simp_tac (simpset() addsimps [less_not_refl2]) 1);
 | 
|  |     86 | by (asm_simp_tac (simpset() addsimps [diff_diff_right, leI, m_comm]) 1);
 | 
|  |     87 | (* end of subproof deg f1 < deg f *)
 | 
|  |     88 | by (etac exE 1);
 | 
|  |     89 | by (res_inst_tac [("x", "((%(q,r,k). ((lcoeff g ^ k * lcoeff x) *s monom (deg x - deg g) + q)) xa, (%(q,r,k). r) xa, (%(q,r,k). Suc k) xa)")] exI 1);
 | 
|  |     90 | by (Clarify_tac 1);
 | 
|  |     91 | by (rtac conjI 1);
 | 
|  |     92 | by (dtac sym 1);
 | 
|  |     93 | by (simp_tac (simpset() addsimps [l_distr, a_assoc]) 1);
 | 
|  |     94 | by (Asm_simp_tac 1);
 | 
|  |     95 | by (simp_tac (simpset() addsimps a_ac@[smult_l_distr, smult_r_distr, smult_r_minus, smult_assoc2, smult_assoc1]) 1);
 | 
|  |     96 | by Auto_tac;
 | 
|  |     97 | qed "long_div_eucl_size";
 | 
|  |     98 | 
 | 
|  |     99 | Goal
 | 
|  |    100 |   "!!g::('a::ring up). g ~= <0> ==> \
 | 
|  |    101 | \    Ex (% (q, r, k). \
 | 
|  |    102 | \      (lcoeff g)^k *s f = q * g + r & (r = <0> | deg r < deg g))";
 | 
|  |    103 | by (forw_inst_tac [("f", "f")]
 | 
|  |    104 |   (simplify (simpset() addsimps [eucl_size_def]) long_div_eucl_size) 1);
 | 
|  |    105 | by Auto_tac;
 | 
|  |    106 | by (case_tac "aa = <0>" 1);
 | 
|  |    107 | by (Blast_tac 1);
 | 
|  |    108 | (* case "aa ~= <0> *)
 | 
|  |    109 | by (rotate_tac ~1 1);
 | 
|  |    110 | by Auto_tac;
 | 
|  |    111 | qed "long_div_ring";
 | 
|  |    112 | 
 | 
|  |    113 | Goal
 | 
|  |    114 |   "!!g::('a::ring up). [| g ~= <0>; (lcoeff g) dvd <1> |] ==> \
 | 
|  |    115 | \    Ex (% (q, r). f = q * g + r & (r = <0> | deg r < deg g))";
 | 
|  |    116 | by (forw_inst_tac [("f", "f")] long_div_ring 1);
 | 
|  |    117 | by (etac exE 1);
 | 
| 10448 |    118 | by (res_inst_tac [("x", "((%(q,r,k). (inverse(lcoeff g ^k) *s q)) x, \
 | 
|  |    119 | \  (%(q,r,k). inverse(lcoeff g ^k) *s r) x)")] exI 1);
 | 
| 7998 |    120 | by (Clarify_tac 1);
 | 
|  |    121 | by (Simp_tac 1);
 | 
|  |    122 | by (rtac conjI 1);
 | 
|  |    123 | by (dtac sym 1);
 | 
|  |    124 | by (asm_simp_tac (simpset() addsimps [smult_r_distr RS sym, smult_assoc2]) 1);
 | 
|  |    125 | by (asm_simp_tac (simpset() addsimps [l_inverse_ring, unit_power, smult_assoc1 RS sym]) 1);
 | 
|  |    126 | (* degree property *)
 | 
|  |    127 | by (etac disjE 1);
 | 
|  |    128 | by (Asm_simp_tac 1);
 | 
|  |    129 | by (rtac disjI2 1);
 | 
|  |    130 | by (rtac le_less_trans 1);
 | 
|  |    131 | by (rtac deg_smult_ring 1);
 | 
| 8006 |    132 | by (Asm_simp_tac 1);
 | 
| 7998 |    133 | qed "long_div_unit";
 | 
|  |    134 | 
 | 
|  |    135 | Goal
 | 
|  |    136 |   "!!g::('a::field up). g ~= <0> ==> \
 | 
|  |    137 | \    Ex (% (q, r). f = q * g + r & (r = <0> | deg r < deg g))";
 | 
|  |    138 | by (rtac long_div_unit 1);
 | 
|  |    139 | by (assume_tac 1);
 | 
|  |    140 | by (asm_simp_tac (simpset() addsimps [lcoeff_def, nonzero_lcoeff, field_ax]) 1);
 | 
|  |    141 | qed "long_div_theorem";
 | 
|  |    142 | 
 | 
|  |    143 | Goal
 | 
|  |    144 |   "!!g::('a::field up). [| g ~= <0>; \
 | 
|  |    145 | \    f = q1 * g + r1; (r1 = <0> | deg r1 < deg g); \
 | 
|  |    146 | \    f = q2 * g + r2; (r2 = <0> | deg r2 < deg g) |] ==> q1 = q2";
 | 
|  |    147 | by (subgoal_tac "(q1 -- q2) * g = r2 -- r1" 1); (* 1 *)
 | 
|  |    148 | by (thin_tac "f = ?x" 1);
 | 
|  |    149 | by (thin_tac "f = ?x" 1);
 | 
|  |    150 | by (rtac diff_zero_imp_eq 1);
 | 
|  |    151 | by (rtac classical 1);
 | 
|  |    152 | by (etac disjE 1);
 | 
|  |    153 | (* r1 = <0> *)
 | 
|  |    154 | by (etac disjE 1);
 | 
|  |    155 | (* r2 = <0> *)
 | 
| 8707 |    156 | by (force_tac (claset() addDs [integral], simpset()) 1);
 | 
| 7998 |    157 | (* r2 ~= <0> *)
 | 
|  |    158 | by (dres_inst_tac [("f", "deg"), ("y", "r2 -- r1")] arg_cong 1);
 | 
| 8707 |    159 | by (Force_tac 1);
 | 
| 7998 |    160 | (* r1 ~=<0> *)
 | 
|  |    161 | by (etac disjE 1);
 | 
|  |    162 | (* r2 = <0> *)
 | 
|  |    163 | by (dres_inst_tac [("f", "deg"), ("y", "r2 -- r1")] arg_cong 1);
 | 
| 8707 |    164 | by (Force_tac 1);
 | 
| 7998 |    165 | (* r2 ~= <0> *)
 | 
|  |    166 | by (dres_inst_tac [("f", "deg"), ("y", "r2 -- r1")] arg_cong 1);
 | 
| 8707 |    167 | by (Asm_full_simp_tac 1);
 | 
| 7998 |    168 | by (dtac (order_eq_refl RS add_leD2) 1);
 | 
|  |    169 | by (dtac leD 1);
 | 
|  |    170 | by (etac notE 1 THEN rtac (deg_add RS le_less_trans) 1);
 | 
|  |    171 | by (Asm_simp_tac 1);
 | 
|  |    172 | (* proof of 1 *)
 | 
|  |    173 | by (rtac diff_zero_imp_eq 1);
 | 
|  |    174 | by (Asm_full_simp_tac 1);
 | 
|  |    175 | by (dres_inst_tac [("a", "?x+?y")] eq_imp_diff_zero 1);
 | 
|  |    176 | by (asm_full_simp_tac (simpset() addsimps (l_distr::minus_add::l_minus::a_ac)) 1);
 | 
|  |    177 | qed "long_div_quo_unique";
 | 
|  |    178 | 
 | 
|  |    179 | Goal
 | 
|  |    180 |   "!!g::('a::field up). [| g ~= <0>; \
 | 
|  |    181 | \    f = q1 * g + r1; (r1 = <0> | deg r1 < deg g); \
 | 
|  |    182 | \    f = q2 * g + r2; (r2 = <0> | deg r2 < deg g) |] ==> r1 = r2";
 | 
|  |    183 | by (subgoal_tac "q1 = q2" 1);
 | 
|  |    184 | by (Clarify_tac 1);
 | 
|  |    185 | by (asm_full_simp_tac (simpset() addsimps [a_lcancel_eq]) 1);
 | 
|  |    186 | by (rtac long_div_quo_unique 1);
 | 
|  |    187 | by (REPEAT (atac 1));
 | 
|  |    188 | qed "long_div_rem_unique";
 |