needs "Library/ringtheory.ml";;
needs "Library/products.ml";;

prioritize_real();; (* to ensure portability *)

(* ----- tactics *)

let rw = REWRITE_TAC;;
let once_rw = ONCE_REWRITE_TAC;;
let qed = ASM_MESON_TAC;;
let simp = ASM_SIMP_TAC;;
let pass = ALL_TAC;;
let splitcases t why = ASM_CASES_TAC t THENL why;;
let handlecase t why = splitcases t [why; pass];;
let conjunction why = CONJ_TAC THENL why;;
let forwardreverse why = EQ_TAC THENL why;;
let sufficesby x = MATCH_MP_TAC x;;
let intro = REPEAT STRIP_TAC;;
let intro_genonly = REPEAT GEN_TAC;;
let subgoal t = SUBGOAL_THEN t ASSUME_TAC;;

let proven_if t = splitcases t 
[qed [];
  pass];;

let havetac t tac = SUBGOAL_THEN t MP_TAC THENL
[tac;
  pass] THEN
DISCH_THEN(fun th -> ASSUME_TAC th);;

let have t why = havetac t(qed why);;

let have_eqlambda t why = havetac t(sufficesby EQ_EXT THEN
  rw [BETA_THM] THEN
  qed why);;

let specialize v th = ASSUME_TAC(UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL v th)));;
let specialize_raw v th = ASSUME_TAC(REWRITE_RULE [IMP_CONJ] (ISPECL v th));;

let specialize_forward v th = ASSUME_TAC(UNDISCH_ALL (fst (EQ_IMP_RULE (UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL v th))))));;

let specialize_reverse v th = ASSUME_TAC(UNDISCH_ALL (snd (EQ_IMP_RULE (UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL v th))))));;

let choose_specializing t v th = X_CHOOSE_TAC t(UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL v th)));;

let specialize_forward_strip v th = STRIP_ASSUME_TAC(UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (fst (EQ_IMP_RULE (ISPECL v th)))));;

let specialize_strip v th = STRIP_ASSUME_TAC(UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL v th)));;

let real_cancel t = specialize[](REAL_FIELD t);;
let real_linear t = specialize[](REAL_ARITH t);;
let int_linear t = specialize[](INT_ARITH t);;
let num_linear t = specialize[](ARITH_RULE t);;
let set_tac t why = havetac t(SET_TAC why);;

let def n d = X_CHOOSE_TAC n(MESON [] (mk_exists (n, mk_eq (n, d))));;

let choose n p why = have(mk_exists (n, p)) why THEN
X_CHOOSE_TAC n(UNDISCH (TAUT (mk_imp (mk_exists (n, p), mk_exists (n, p)))));;

(* ----- naturals *)

let zero_if_mul_lt = prove(`
  !m n:num.
  m * n < n ==> m = 0
`,
  qed[ARITH_RULE `1 * n = n`;LT_MULT_RCANCEL;ARITH_RULE `m < 1 ==> m = 0`]
);;

let lt_rmult = prove(`
  !a b c:num.
  ~(c = 0) ==>
  a < b ==>
  a * c < b * c
`,
  qed[LT_LMULT;MULT_SYM]
);;

let le_minus_1_if_lt = prove(`
  !m n:num.
  m < n ==> m <= n-1
`,
  intro THEN
  choose `d:num` `n = m + SUC d` [LT_EXISTS] THEN
  have `n = m+(d+1)` [ADD1] THEN
  have `n = (m+d)+1` [ADD_ASSOC] THEN
  have `n = 1+(m+d)` [ADD_SYM] THEN
  have `n-1 = m+d` [ADD_SUB2] THEN
  qed[LE_EXISTS]
);;

let minus_1_lt_if_lt = prove(`
  !m n:num.
  m < n ==> n-1 < n
`,
  intro THEN
  choose `d:num` `n = m + SUC d` [LT_EXISTS] THEN
  have `n = m+(d+1)` [ADD1] THEN
  have `n = (m+d)+1` [ADD_ASSOC] THEN
  have `n = 1+(m+d)` [ADD_SYM] THEN
  have `n-1 = m+d` [ADD_SUB2] THEN
  have `n-1 < SUC (n-1)` [LT] THEN
  qed[ADD1]
);;

(* ----- sets *)

let disjoint_union_delete_as_union = prove(`
  !(S:X->bool) T U t.
  U = S UNION T ==>
  DISJOINT S T ==>
  t IN T ==>
  U DELETE t = S UNION (T DELETE t)
`,
  SET_TAC[]
);;

let disjoint_union_delete_disjoint = prove(`
  !(S:X->bool) T U t.
  U = S UNION T ==>
  DISJOINT S T ==>
  t IN T ==>
  DISJOINT S (T DELETE t)
`,
  SET_TAC[]
);;

let insert_delete_nonmember = prove(`
  !(x:X) S.
  ~(x IN S) ==>
  (x INSERT S) DELETE x = S
`,
  SET_TAC[]
);;

let filter_union_filternot = prove(`
  !(S:X->bool) P.
  S = {s | s IN S /\ P s} UNION {s | s IN S /\ ~(P s)}
`,
  SET_TAC[]
);;

let filter_disjoint_filternot = prove(`
  !(S:X->bool) P.
  DISJOINT {s | s IN S /\ P s} {s | s IN S /\ ~(P s)}
`,
  SET_TAC[]
);;

let image_empty = prove(`
  !f:A->B. IMAGE f {} = {}
`,
  qed[IMAGE_EQ_EMPTY]
);;

let image_sing = prove(`
  !f:A->B. IMAGE f {x} = {f x}
`,
  SET_TAC[]
);;

let image_pair = prove(`
  !P f:A->B->C.
  IMAGE (\(a,b). f a b) {a,b | P a b}
  = {f a b | P a b}
`,
  rw[EXTENSION;IN_ELIM_THM;IN_IMAGE] THEN
  intro THEN
  forwardreverse [
    STRIP_TAC THEN
    EXISTS_TAC `a:A` THEN
    EXISTS_TAC `b:B` THEN
    have `(x:C) = (\((a:A),(b:B)). f a b) (a,b)` [] THEN
    simp[]
  ;
    STRIP_TAC THEN
    EXISTS_TAC `a:A,b:B` THEN
    conjunction [
      simp[]
    ;
      EXISTS_TAC `a:A` THEN
      EXISTS_TAC `b:B` THEN
      simp[]
    ]
  ]
);;

let injective_pair_rewrite = prove(`
  !f:A#B->L.
  (!(a,b) (c,d). f (a,b) = f (c,d) ==> (a,b) = (c,d)) ==>
  !x y. f x = f y ==> x = y
`,
  rw[FORALL_PAIRED_THM] THEN
  qed[PAIR_SURJECTIVE]
);;

let sing_self = prove(`
  !x:A. {x} x
`,
  qed[IN_SING;IN]
);;

let sing_eq = prove(`
  !x y:A. {x} y <=> x = y
`,
  qed[IN_SING;IN]
);;

let setof_property = prove(`
  !P:A->bool. {x | P x} = P
`,
  SET_TAC[]
);;

let setof_property_apply = prove(`
  !P:A->bool y:A. {x | P x} y = P y
`,
  SET_TAC[]
);;

let in_empty = prove(`
  !x:A. x IN {} <=> F
`,
  SET_TAC[]
);;

let nonempty_if_element = prove(`
  !x:A S. S x ==> ~(S = {})
`,
  SET_TAC[]
);;

let lambda_pair_apply = prove(`
  !(f:A->B->X) c:A d:B.
  (\(a,b). f a b) (c,d) = f c d
`,
  simp[]
);;

(* ----- sets of naturals *)

let lt_double1_as_disjoint_union_lt = prove(`
  !t:num.
  {i | i < t+(t+1)}
  = {i | t <= i /\ i < t+(t+1)} UNION {i | i < t}
  /\
  DISJOINT {i | t <= i /\ i < t+(t+1)} {i | i < t}
`,
  rw[UNION;IN_DISJOINT;EXTENSION;IN_ELIM_THM] THEN
  qed[ARITH_RULE `i < t+(t+1) <=> i < t \/ (t <= i /\ i < t+(t+1))`;ARITH_RULE `~((i < t) /\ (t <= i /\ i < t+(t+1)))`]
);;

let range_shift = prove(`
  !m n:num.
  IMAGE (\x:num. m+x) {j:num | j < n}
  = {i:num | m <= i /\ i < m+n}
`,
  rw[IMAGE;EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  forwardreverse [
    intro
  ;
    intro THEN
    choose `d:num` `x = m + d:num` [LE_EXISTS] THEN
    EXISTS_TAC `d:num`
  ] THEN
  ASM_ARITH_TAC
);;

let image_numseg_antidiagonal = prove(`
  !d:num.
  IMAGE (\a:num. a,d-a) {a:num | a <= d}
  = {a,b | a + b = d}
`,
  rw[IMAGE;EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  forwardreverse [
    intro THEN
    EXISTS_TAC `x':num` THEN
    EXISTS_TAC `d - x':num` THEN
    qed[SUB_ADD;ADD_SYM]
  ;
    intro THEN
    EXISTS_TAC `a:num` THEN
    qed[LE_EXISTS;ADD_SUB2]
  ]
);;

let range_delete_top = prove(`
  !n:num.
  {i:num | i < n} DELETE (n-1) = {i | i < n-1}
`,
  rw[DELETE;EXTENSION;IN_ELIM_THM] THEN
  ARITH_TAC
);;

let range_delete_bot = prove(`
  !n:num.
  {i:num | i < n} DELETE 0 = {i | 0 < i /\ i < n}
`,
  rw[DELETE;EXTENSION;IN_ELIM_THM] THEN
  ARITH_TAC
);;

let range_shift_is_range_delete_0 = prove(`
  !n f.
  f = (\j:num. j+1) ==>
  IMAGE f {j | j < n-1} = {i | i < n} DELETE 0
`,
  simp[IMAGE;DELETE;EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  forwardreverse [
    STRIP_TAC THEN
    qed[ARITH_RULE `a < b-1 ==> a+1 < b`;ARITH_RULE `~(a+1 = 0)`];
    STRIP_TAC THEN
    EXISTS_TAC `x-1` THEN
    qed[ARITH_RULE `x < n ==> ~(x = 0) ==> x-1 < n-1`;ARITH_RULE `~(x = 0) ==> x = x-1+1`]
  ]
);;

(* ----- maximum elements of sets of naturals *)

let maximum = new_definition `
  maximum S
  = @m:num. S m /\ (!n. m < n ==> ~(S n))
`;;

let maximum_if = prove(`
  !S m.
  S m ==>
  (!n. m < n ==> ~(S n)) ==>
  maximum S = m
`,
  intro THEN
  rw[maximum] THEN
  sufficesby SELECT_UNIQUE THEN
  GEN_TAC THEN
  forwardreverse [
    simp[] THEN
    splitcases `y < m:num` [
      qed[];
      splitcases `m < y:num` [
        qed[];
        qed[LT_CASES]
      ]
    ];
    qed[]
  ]
);;

let maximum_sing = prove(`
  !d:num. maximum {d} = d
`,
  GEN_TAC THEN
  have `d IN {d:num}` [IN_SING] THEN
  have `{d:num} d` [IN] THEN
  have `!n. d < n ==> ~(n IN {d:num})` [LT_REFL;IN_SING] THEN
  have `!n. d < n ==> ~({d:num} n)` [IN] THEN
  qed[maximum_if]
);;

let maximum_insert_above_lemma = prove(`
  !S x:num.
  (!s. S s ==> s <= x) ==>
  !n. x < n ==> ~((x INSERT S) n)
`,
  rw[INSERT;IN;IN_ELIM_THM] THEN
  qed[LT_REFL;NOT_LT]
);;

let maximum_insert_above = prove(`
  !S x:num.
  (!s. S s ==> s <= x) ==>
  maximum (x INSERT S) = x
`,
  intro THEN
  set_tac `(x:num) IN (x INSERT S)` [] THEN
  have `(x INSERT S) (x:num)` [IN] THEN
  have `!n:num. x < n ==> ~((x INSERT S) n)` [maximum_insert_above_lemma] THEN
  qed[maximum_if]
);;

let maximum_insert_below_lemma1 = prove(`
  !S x.
  S (maximum S) ==>
  (x INSERT S) (maximum S)
`,
  rw[INSERT;IN;IN_ELIM_THM] THEN
  qed[]
);;

(* would also hold with x <= s, but not needed here *)
let maximum_insert_below_lemma2 = prove(`
  !S x s.
  S (maximum S) ==>
  (!n. maximum S < n ==> ~(S n)) ==>
  S s ==>
  x < s ==>
  !n. maximum S < n ==> ~((x INSERT S) n)
`,
  rw[INSERT;IN;IN_ELIM_THM] THEN
  intro THENL [
    qed[];
    qed[LT_TRANS]
  ]
);;

let maximum_insert_below = prove(`
  !S x s.
  S (maximum S) ==>
  (!n. maximum S < n ==> ~(S n)) ==>
  S s ==>
  x < s ==>
  maximum (x INSERT S) = maximum S
`,
  intro THEN
  have `(x INSERT S) (maximum S)` [maximum_insert_below_lemma1] THEN
  have `!n. maximum S < n ==> ~((x INSERT S) n)` [maximum_insert_below_lemma2] THEN
  qed[maximum_if]
);;

let maximum_finite_nonempty = prove(`
  !S.
  FINITE S ==>
  ~(S = {}) ==>
  S (maximum S) /\ (!n. maximum S < n ==> ~(S n))
`,
  sufficesby FINITE_INDUCT_STRONG THEN
  conjunction [
    qed[];
    intro_genonly THEN
    DISCH_TAC THEN
    splitcases `(S:num->bool) = {}` [
      simp[] THEN
      rw[maximum_sing;sing_self;sing_eq] THEN
      ARITH_TAC;
      splitcases `(!s:num. S s ==> s <= x)` [
        simp[maximum_insert_above] THEN
        rw[INSERT;IN_ELIM_THM;IN] THEN
        qed[NOT_LT;LT_REFL];
        choose `s:num` `S (s:num) /\ x < s` [NOT_LT] THEN
        have `~((S:num->bool) = {})` [nonempty_if_element] THEN
        have `maximum (x INSERT S) = maximum S` [maximum_insert_below] THEN
        simp[maximum_insert_below_lemma1;maximum_insert_below_lemma2]
      ]
    ]
  ]
);;

let element_le_maximum_finite = prove(`
  !S. FINITE S ==>
  !m. S m ==> m <= maximum S
`,
  intro THEN
  have `~((S:num->bool) = {})` [nonempty_if_element] THEN
  qed[maximum_finite_nonempty;NOT_LT]
);;

let element_le_maximum_finite_setof = prove(`
  !P m.
  FINITE P ==>
  P m ==>
  m <= maximum {x | P x}
`,
  rw[setof_property] THEN
  qed[element_le_maximum_finite]
);;

(* ----- rings *)

let ring_sub_cancel = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_sub r a a = ring_0 r
`,
  RING_TAC
);;

let ring_add_sub_cancel = prove(`
  !(r:A ring) a b.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ring_add r a (ring_sub r b a) = b
`,
  RING_TAC
);;

let ring_add_sub_cancel2 = prove(`
  !(r:A ring) a b.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ring_sub r (ring_add r a b) b = a
`,
  RING_TAC
);;

let ring_sub_add_cancel = prove(`
  !(r:A ring) a b.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ring_add r (ring_sub r a b) b = a
`,
  RING_TAC
);;

let ring_sub_add_add_cancel = prove(`
  !(r:A ring) a b c.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  c IN ring_carrier r ==>
  ring_sub r (ring_add r a c) (ring_add r b c) = ring_sub r a b
`,
  RING_TAC
);;

let ring_0_add = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_add r (ring_0 r) a = a
`,
  RING_TAC
);;

let ring_add_0 = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_add r a (ring_0 r) = a
`,
  RING_TAC
);;

let ring_0_mul = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_mul r (ring_0 r) a = ring_0 r
`,
  RING_TAC
);;

let ring_mul_0 = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_mul r a (ring_0 r) = ring_0 r
`,
  RING_TAC
);;

let ring_1_mul = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_mul r (ring_1 r) a = a
`,
  RING_TAC
);;

let ring_mul_1 = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_mul r a (ring_1 r) = a
`,
  RING_TAC
);;

let ring_nonzero_if_mul_nonzero = prove(`
  !(r:A ring) a b.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ~(ring_mul r a b = ring_0 r) ==>
  ~(a = ring_0 r) /\ ~(b = ring_0 r)
`,
  RING_TAC
);;

let ring_add_zero = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_add r a (ring_0 r) = a
`,
  RING_TAC
);;

let ring_sum_nonzero = prove(`
  !r (f:K->A) s.
  ~(ring_sum r s f = ring_0 r) ==>
  ?z. z IN s /\ f z IN ring_carrier r /\ ~(f z = ring_0 r)
`,
  qed[RING_SUM_EQ_0]
);;

let ring_sum_sub = prove(`
  !(r:A ring) (f:X->A) (g:X->A) S.
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  (!s. s IN S ==> g s IN ring_carrier r) ==>
  ring_sum r S (\s. ring_sub r (f s) (g s))
  = ring_sub r (ring_sum r S f) (ring_sum r S g)
`,
  intro THEN
  have `!s:X. s IN S ==> ring_sub r (f s) (g s) IN ring_carrier(r:A ring)` [RING_SUB] THEN
  specialize_raw[`r:A ring`;`\s:X. ring_sub(r:A ring) (f s) (g s)`;`g:X->A`;`S:X->bool`]RING_SUM_ADD THEN
  have `ring_sum (r:A ring) (S:X->bool) (\s. ring_add r (ring_sub r (f s) (g s)) (g s)) = ring_add r (ring_sum r S (\s. ring_sub r (f s) (g s))) (ring_sum r S g)` [] THEN
  have `!s:X. s IN S ==> ring_add(r:A ring) (ring_sub r (f s) (g s)) (g s) = f s` [ring_sub_add_cancel] THEN
  have `ring_sum (r:A ring) (S:X->bool) f = ring_add r (ring_sum r S (\s. ring_sub r (f s) (g s))) (ring_sum r S g)` [RING_SUM_EQ] THEN
  have `ring_sum(r:A ring) (S:X->bool) g IN ring_carrier r` [RING_SUM] THEN
  have `ring_sum(r:A ring) (S:X->bool) (\s. ring_sub r (f s) (g s)) IN ring_carrier r` [RING_SUM] THEN
  qed[ring_add_sub_cancel2]
);;

let ring_sum_diff2 = prove(`
  !r (f:K->A) s t.
  FINITE s ==>
  t SUBSET s ==>
  ring_sum r s f = ring_add r (ring_sum r t f) (ring_sum r (s DIFF t) f)
`,
  intro THEN
  simp[RING_SUM_DIFF] THEN
  have `ring_sum (r:A ring) s (f:K->A) IN ring_carrier r` [RING_SUM] THEN
  have `ring_sum (r:A ring) t (f:K->A) IN ring_carrier r` [RING_SUM] THEN
  qed[ring_add_sub_cancel]
);;

let ring_sum_delete2 = prove(`
  !(r:A ring) S (f:X->A) s.
  FINITE S ==>
  s IN S ==>
  f s IN ring_carrier r ==>
  ring_sum r S f
  = ring_add r (f s) (ring_sum r (S DELETE s) f)
`,
  intro THEN
  simp[RING_SUM_DELETE] THEN
  have `ring_sum (r:A ring) S (f:X->A) IN ring_carrier r` [RING_SUM] THEN
  qed[ring_add_sub_cancel]
);;

let ring_sum_shift1 = prove(`
  !(r:R ring) f n.
  f 0 = ring_0 r ==>
  ring_sum r {a | a <= n+1} f
  = ring_sum r {a | a <= n} (\a. f (a+1))
`,
  intro THEN
  set_tac `0 IN {a | a <= n+1}` [ARITH_RULE `0 <= n+1`] THEN
  have `f 0 IN ring_carrier(r:R ring)` [RING_0] THEN
  specialize[`n+1`]FINITE_NUMSEG_LE THEN
  specialize[`r:R ring`;`{a | a <= n+1}`;`f:num->R`;`0`]ring_sum_delete2 THEN
  simp[ring_0_add;RING_SUM] THEN
  rw[NUMSEG_LE] THEN
  rw[GSYM RING_SUM_OFFSET] THEN
  have `0 INSERT ((0+1)..(n+1)) = 0..(n+1)` [NUMSEG_LREC;ARITH_RULE `0 <= n+1`] THEN
  have `~(0 IN ((0+1)..(n+1)))` [IN_NUMSEG;ARITH_RULE `~(0+1 <= 0)`] THEN
  have `(0..(n+1)) DELETE 0 = ((0+1)..(n+1))` [insert_delete_nonmember] THEN
  simp[]
);;

let ring_sum_insert_top = prove(`
  !(r:R ring) f n.
  f (n+1) = ring_0 r ==>
  ring_sum r {a | a <= n+1} f
  = ring_sum r {a | a <= n} f
`,
  intro THEN
  set_tac `n+1 IN {a | a <= n+1}` [ARITH_RULE `n+1 <= n+1`] THEN
  have `f (n+1) IN ring_carrier(r:R ring)` [RING_0] THEN
  specialize[`n+1`]FINITE_NUMSEG_LE THEN
  specialize[`r:R ring`;`{a | a <= n+1}`;`f:num->R`;`n+1`]ring_sum_delete2 THEN
  simp[ring_0_add;RING_SUM] THEN
  have `(n+1) INSERT (0..((n+1)-1)) = 0..(n+1)` [NUMSEG_RREC;ARITH_RULE `0 <= n+1`] THEN
  have `(n+1)-1 = n` [ADD_SUB] THEN
  have `(n+1) INSERT (0..n) = 0..(n+1)` [NUMSEG_RREC;ARITH_RULE `0 <= n+1`] THEN
  have `~((n+1) IN (0..n))` [IN_NUMSEG;ARITH_RULE `~(n+1 <= n)`] THEN
  have `(0..(n+1)) DELETE (n+1) = 0..n` [insert_delete_nonmember] THEN
  rw[NUMSEG_LE] THEN
  simp[]
);;

let ring_product_0 = prove(`
  !(r:A ring) S s (f:X->A).
  FINITE S ==>
  s IN S ==>
  f s = ring_0 r ==>
  ring_product r S f = ring_0 r
`,
  intro THEN
  def `D:X->bool` `S DELETE (s:X)` THEN
  have `(s:X) INSERT D = S` [INSERT_DELETE] THEN
  have `FINITE (D:X->bool)` [FINITE_DELETE] THEN
  have `~((s:X) IN D)` [IN_DELETE] THEN
  have `f(s:X) IN ring_carrier(r:A ring)` [RING_0] THEN
  have `ring_product (r:A ring) S (f:X->A) = ring_mul r (f s) (ring_product r D f)` [RING_PRODUCT_CLAUSES] THEN
  have `ring_product (r:A ring) D (f:X->A) IN ring_carrier r` [RING_PRODUCT] THEN
  qed[ring_0_mul]
);;

let ring_sum_image_injective = prove(`
  !r (f:K->L) (g:L->A) s.
  (!x y. f x = f y ==> x = y)
  ==> ring_sum r (IMAGE f s) g = ring_sum r s (g o f)
`,
  qed[RING_SUM_IMAGE]
);;

let ring_sum_image_injective_pair = prove(`
  !r (f:A#B->L) (g:L->X) s.
  (!(a,b) (c,d). f (a,b) = f (c,d) ==> (a,b) = (c,d))
  ==> ring_sum r (IMAGE f s) g = ring_sum r s (g o f)
`,
  intro THEN
  have `!x y. (f:A#B->L) x = f y ==> x = y` [injective_pair_rewrite] THEN
  qed[ring_sum_image_injective]
);;

let ring_sum_range_delete_0 = prove(`
  !(r:A ring) n g.
  ring_sum r ({i:num | i < n} DELETE 0) g
  = ring_sum r {j:num | j < n-1} (\j:num. g (j+1))
`,
  intro THEN
  def `f:num->num` `\j. j+1` THEN
  have `!x y:num. (f:num->num) x = f y ==> x = y` [ARITH_RULE `x+1 = y+1 ==> x = y`] THEN
  have `ring_sum (r:A ring) {j | j < n-1} (g o (f:num->num)) = ring_sum r (IMAGE f {j | j < n-1}) g` [ring_sum_image_injective] THEN
  have_eqlambda `(g:num->A) o (f:num->num) = (\j. g(j+1))` [o_THM] THEN
  have `IMAGE f {j | j < n-1} = {i | i < n} DELETE 0` [range_shift_is_range_delete_0] THEN
  qed[]
);;

let ring_sum_delta_fun = prove(`
  !(r:R ring) S (i:X) (f:X->R).
  ring_sum r S (\j. if j = i then f j else ring_0 r) =
  if i IN S /\ f i IN ring_carrier r then f i else ring_0 r
`,
  intro THEN
  have_eqlambda `(\j:X. if j = i then f j else ring_0(r:R ring)) = (\j:X. if j = i then f i else ring_0 r)` [] THEN
  specialize[`r:R ring`;`S:X->bool`;`i:X`;`(f:X->R) i`]RING_SUM_DELTA THEN
  qed[]
);;
  
let ring_sum_delta_flip = prove(`
  !(r:R ring) S (i:X) a.
  ring_sum r S (\j. if i = j then a else ring_0 r) =
  if i IN S /\ a IN ring_carrier r then a else ring_0 r
`,
  intro THEN
  have_eqlambda `(\j:X. if i = j then (a:R) else ring_0 r) = (\j:X. if j = i then (a:R) else ring_0 r)` [] THEN
  qed[RING_SUM_DELTA]
);;

let ring_sum_delta_flip_fun = prove(`
  !(r:R ring) S (i:X) (f:X->R).
  ring_sum r S (\j. if i = j then f j else ring_0 r) =
  if i IN S /\ f i IN ring_carrier r then f i else ring_0 r
`,
  intro THEN
  have_eqlambda `(\j:X. if i = j then f j else ring_0(r:R ring)) = (\j:X. if i = j then f i else ring_0 r)` [] THEN
  specialize[`r:R ring`;`S:X->bool`;`i:X`;`(f:X->R) i`]ring_sum_delta_flip THEN
  qed[]
);;
  
let ring_divides_sum = prove(`
  !(r:A ring) d S (f:X->A).
  d IN ring_carrier r ==>
  (!s. s IN S ==> ring_divides r d (f s)) ==>
  ring_divides r d (ring_sum r S f)
`,
  intro THEN
  sufficesby RING_SUM_CLOSED THEN
  qed[RING_DIVIDES_ADD;RING_DIVIDES_0]
);;

let ring_sum_range_shift = prove(`
  !(r:R ring) m n f.
  ring_sum r {i:num | m <= i /\ i < m+n} f
  = ring_sum r {j:num | j < n} (\j. f (m+j))
`,
  intro THEN
  num_linear `!x y:num. m+x = m+y ==> x = y` THEN
  have `IMAGE (\x:num. m+x) {j:num | j < n} = {i:num | m <= i /\ i < m+n}` [range_shift] THEN
  have_eqlambda `(\j:num. f (m+j):R) = f o (\x. m+x)` [o_THM] THEN
  qed[ring_sum_image_injective]
);;

let ring_nonzero_if_divides_nonzero = prove(`
  !(r:R ring) a b.
  ring_divides r a b ==>
  ~(b = ring_0 r) ==>
  ~(a = ring_0 r)
`,
  qed[ring_divides;ring_0_mul]
);;

let poly_const_mul_expand_lemma = prove(`
  !(r:A ring) c:A (p:(V->num)->A) (m:V->num).
  ring_powerseries r p ==>
  {m1m2 | m1m2 IN {m1,m2 | monomial_mul m1 m2 = m}
          /\ ~((\ (m1,m2). ring_mul r (if m1 = monomial_1 then c else ring_0 r) (p m2)) m1m2 = ring_0 r)}
  = if ring_mul r c (p m) = ring_0 r
    then {}
    else {(monomial_1,m)}
`,
  intro THEN
  have `!m. (p:(V->num)->A) m IN ring_carrier r` [ring_powerseries] THEN
  rw[EXTENSION;IN_ELIM_THM] THEN
  GEN_TAC THEN
  forwardreverse [
    STRIP_TAC THEN
    havetac `(\(m1,m2). ring_mul (r:A ring) (if (m1:V->num) = monomial_1 then c else ring_0 r) ((p:(V->num)->A) m2)) x = ring_mul r (if (m1:V->num) = monomial_1 then c else ring_0 r) (p m2)` (simp[]) THEN
    have `~(ring_mul r (if (m1:V->num) = monomial_1 then c else ring_0 r) ((p:(V->num)->A) m2) = ring_0 r)` [] THEN
    splitcases `(m1:V->num) = monomial_1` [
      have `~(ring_mul r c ((p:(V->num)->A) m2) = ring_0 r)` [] THEN
      have `monomial_mul m1 m2 = (m2:V->num)` [MONOMIAL_MUL_LID] THEN
      have `m = (m2:V->num)` [] THEN
      simp[] THEN
      qed[IN_SING]
    ;
      have `~(ring_mul r (ring_0 r) ((p:(V->num)->A) m2) = ring_0 r)` [] THEN
      have `(p:(V->num)->A) m2 IN ring_carrier r` [] THEN
      have `~(ring_0 (r:A ring) = ring_0 r)` [ring_0_mul] THEN
      qed[ring_0_mul]
    ]
  ;
    splitcases `ring_mul (r:A ring) c ((p:(V->num)->A) m) = ring_0 r` [
      simp[] THEN
      qed[NOT_IN_EMPTY]
    ;
      simp[] THEN
      rw[IN_SING] THEN
      STRIP_TAC THEN
      conjunction [
        EXISTS_TAC `(monomial_1:V->num)` THEN
        EXISTS_TAC `(m:V->num)` THEN
        simp[MONOMIAL_MUL_LID]
      ;
        simp[LAMBDA_PAIR]
      ]
    ]
  ]
);;

let poly_const_mul_expand = prove(`
  !(r:A ring) c:A (p:(V->num)->A).
  ring_powerseries r p ==>
  c IN ring_carrier r ==>
  poly_mul(r) (poly_const r c) p
  = \m. ring_mul r c (p m)
`,
  rw[poly_mul;poly_const] THEN
  once_rw[FUN_EQ_THM] THEN
  simp[] THEN
  once_rw[GSYM RING_SUM_SUPPORT] THEN
  intro THEN
  simp[poly_const_mul_expand_lemma] THEN
  splitcases `ring_mul (r:A ring) c ((p:(V->num)->A) x) = ring_0 r` [
    simp[] THEN
    qed[RING_SUM_CLAUSES]
  ;
    simp[] THEN
    rw[RING_SUM_SING] THEN
    have `(p:(V->num)->A) x IN ring_carrier r` [ring_powerseries] THEN
    have `ring_mul r c ((p:(V->num)->A) x) IN ring_carrier r` [RING_MUL] THEN
    qed[]
  ]
);;

let lowest_terms_divides = prove(`
  !(r:R ring) a b c d.
  integral_domain r ==>
  (UFD r \/ bezout_ring r) ==>
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  c IN ring_carrier r ==>
  d IN ring_carrier r ==>
  ring_coprime r (a,b) ==>
  ring_mul r a d = ring_mul r b c ==>
  ?L.
     L IN ring_carrier r
  /\ c = ring_mul r a L
  /\ d = ring_mul r b L
`,
  REPEAT GEN_TAC THEN
  REPEAT DISCH_TAC THEN
  handlecase `~(a = ring_0(r:R ring))` (
    have `ring_mul r b c IN ring_carrier(r:R ring)` [RING_MUL] THEN
    have `ring_divides(r:R ring) a (ring_mul r b c)` [ring_divides] THEN
    have `ring_coprime(r:R ring) (b,a)` [RING_COPRIME_SYM] THEN
    have `ring_divides(r:R ring) a c` [RING_COPRIME_DIVPROD_LEFT] THEN
    choose `L:R` `L IN ring_carrier(r:R ring) /\ c = ring_mul r a L` [ring_divides] THEN
    have `ring_mul(r:R ring) a d = ring_mul r a (ring_mul r b L)` [RING_RULE `ring_mul(r:R ring) b (ring_mul r a L) = ring_mul r a (ring_mul r b L)`] THEN
    have `ring_mul r b L IN ring_carrier(r:R ring)` [RING_MUL] THEN
    have `d = ring_mul(r:R ring) b L` [INTEGRAL_DOMAIN_MUL_LCANCEL] THEN
    qed[]
  ) THEN
  handlecase `~(b = ring_0(r:R ring))` (
    have `ring_mul r a d IN ring_carrier(r:R ring)` [RING_MUL] THEN
    have `ring_divides(r:R ring) b (ring_mul r a d)` [ring_divides] THEN
    have `ring_coprime(r:R ring) (b,a)` [RING_COPRIME_SYM] THEN
    have `ring_divides(r:R ring) b d` [RING_COPRIME_DIVPROD_LEFT] THEN
    choose `L:R` `L IN ring_carrier(r:R ring) /\ d = ring_mul r b L` [ring_divides] THEN
    have `ring_mul(r:R ring) b c = ring_mul r b (ring_mul r a L)` [RING_RULE `ring_mul(r:R ring) a (ring_mul r b L) = ring_mul r b (ring_mul r a L)`] THEN
    have `ring_mul r a L IN ring_carrier(r:R ring)` [RING_MUL] THEN
    have `c = ring_mul(r:R ring) a L` [INTEGRAL_DOMAIN_MUL_LCANCEL] THEN
    qed[]
  ) THEN
  have `a = ring_0(r:R ring)` [] THEN
  have `b = ring_0(r:R ring)` [] THEN
  have `trivial_ring(r:R ring)` [RING_COPRIME_00] THEN
  qed[INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]
);;

let ring_sub_mul_mul_mul_mul = prove(`
  !(r:R ring) X Y V M.
  M IN ring_carrier r ==>
  V IN ring_carrier r ==>
  X IN ring_carrier r ==>
  Y IN ring_carrier r ==>
  ring_sub(r:R ring) (ring_mul r X (ring_mul r V M)) (ring_mul r (ring_mul r V Y) M)
  = ring_mul r V (ring_mul r (ring_sub r X Y) M)
`,
  RING_TAC
);;

let ring_div_mul_mul_div = prove(`
 !(r:R ring) a b c.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  c IN ring_carrier r ==>
  ring_mul(r:R ring) (ring_div r b c) a
  = ring_div r (ring_mul r b a) c
`,
  rw[ring_div] THEN
  intro THEN
  have `ring_inv(r:R ring) c IN ring_carrier r` [RING_INV] THEN
  RING_TAC
);;

(* ----- squarefree elements of rings *)

let ring_squarefree = new_definition `
  ring_squarefree(r:R ring) a
  <=> 
  (!b. b IN ring_carrier r ==>
   ring_divides r a (ring_mul r b b) ==>
   ring_divides r a b
  )
`;;

let coprime_primes_divide_product_waterfall = prove(`
  !(r:R ring).
  !P.
  FINITE P ==>
  P SUBSET ring_carrier r ==>
  !b.
  b IN ring_carrier r ==>
  (!p. p IN P ==> ring_prime r p) ==>
  (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==>
  (!p. p IN P ==> ring_divides r p b) ==>
  ring_divides r (ring_product r P I) b
`,
  GEN_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    simp[RING_PRODUCT_CLAUSES] THEN
    qed[RING_DIVIDES_1]
  ;
    have `(x:R) IN x INSERT P` [IN_INSERT] THEN
    have `(x:R) IN ring_carrier r` [SUBSET] THEN
    have `I (x:R) = x` [I_THM] THEN
    have `I (x:R) IN ring_carrier r` [] THEN
    have `ring_product(r:R ring) (x INSERT P) I = ring_mul r x (ring_product r P I)` [RING_PRODUCT_CLAUSES] THEN
    simp[RING_PRODUCT_CLAUSES] THEN
    have `ring_divides r (x:R) b` [] THEN
    choose `c:R` `c IN ring_carrier r /\ (b:R) = ring_mul r x c` [ring_divides] THEN
    subgoal `!q:R. q IN P ==> ring_divides r q c` THENL [
      intro THEN
      have `q:R IN x INSERT P` [IN_INSERT] THEN
      have `q:R IN ring_carrier r` [SUBSET] THEN
      have `ring_divides r (q:R) b` [] THEN
      have `ring_divides r (q:R) (ring_mul r x c)` [] THEN
      have `~(ring_divides r (q:R) x)` [] THEN
      qed[ring_prime]
    ; pass
    ] THEN
    have `!q:R. q IN P ==> ring_prime r q` [IN_INSERT] THEN
    have `!p q:R. p IN P ==> q IN P ==> ring_divides r p q ==> p = q` [IN_INSERT] THEN
    have `P SUBSET (P:R->bool)` [SUBSET_REFL] THEN
    have `P SUBSET ring_carrier(r:R ring)` [SUBSET_INSERT;SUBSET_TRANS] THEN
    have `c:R IN ring_carrier r` [] THEN
    specialize[`c:R`](UNDISCH(ASSUME `P SUBSET ring_carrier(r:R ring) ==> (!b. b IN ring_carrier r ==> (!p. p IN P ==> ring_prime r p) ==> (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==> (!p. p IN P ==> ring_divides r p b) ==> ring_divides r (ring_product r P I) b)`)) THEN
    qed[RING_DIVIDES_REFL;RING_DIVIDES_MUL2]
  ]
);;

let coprime_primes_divide_product = prove(`
  !(r:R ring) P b.
  P SUBSET ring_carrier r ==>
  FINITE P ==>
  b IN ring_carrier r ==>
  (!p. p IN P ==> ring_prime r p) ==>
  (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==>
  (!p. p IN P ==> ring_divides r p b) ==>
  ring_divides r (ring_product r P I) b
`,
  intro THEN
  ASSUME_TAC(ISPECL[`b:R`](UNDISCH_ALL(ISPECL[`r:R ring`;`P:R->bool`]coprime_primes_divide_product_waterfall))) THEN
  qed[]
);;

let ring_squarefree_if_product_coprime_primes = prove(`
  !(r:R ring) P.
  P SUBSET ring_carrier r ==>
  FINITE P ==>
  (!p. p IN P ==> ring_prime r p) ==>
  (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==>
  ring_squarefree r (ring_product r P I)
`,
  rw[ring_squarefree] THEN
  intro THEN
  subgoal `!p:R. p IN P ==> ring_divides r p (ring_product r P I)` THENL [
    intro THEN
    have `(p:R) IN ring_carrier r` [SUBSET] THEN
    have `I (p:R) = p` [I_THM] THEN
    have `I (p:R) IN ring_carrier r` [] THEN
    have `ring_product(r:R ring) {p} I = p` [RING_PRODUCT_SING] THEN
    have `FINITE {p:R}` [FINITE_SING] THEN
    have `{p:R} SUBSET P` [SUBSET;IN_SING] THEN
    qed[RING_DIVIDES_PRODUCT_SUBSET]
  ; pass
  ] THEN
  have `!p:R. p IN P ==> ring_divides r p (ring_mul r b b)` [RING_DIVIDES_TRANS;RING_MUL] THEN
  have `!p:R. p IN P ==> ring_divides r p b` [ring_prime] THEN
  specialize[`r:R ring`;`P:R->bool`;`b:R`]coprime_primes_divide_product THEN
  qed[]
);;

let ring_squarefree_if_prime = prove(`
  !(r:R ring) p.
  ring_prime r p ==> ring_squarefree r p
`,
  intro THEN
  have `p:R IN ring_carrier r` [ring_prime] THEN
  have `{p:R} SUBSET ring_carrier r` [SUBSET;IN_SING] THEN
  have `FINITE {p:R}` [FINITE_SING] THEN
  have `!q:R. q IN {p} ==> ring_prime r q` [IN_SING] THEN
  have `!q x:R. q IN {p} ==> x IN {p} ==> ring_divides r q x ==> q = x` [IN_SING] THEN
  specialize[`r:R ring`;`{p:R}`]ring_squarefree_if_product_coprime_primes THEN
  qed[RING_PRODUCT_SING;I_THM]
);;

let ring_div_pow = prove(`
  !(r:R ring) x y n.
  x IN ring_carrier r ==>
  y IN ring_carrier r ==>
  ring_pow r (ring_div r x y) n
  = ring_div r (ring_pow r x n) (ring_pow r y n)
`,
  rw[ring_div] THEN
  qed[RING_INV_POW;RING_MUL_POW;RING_MUL;RING_INV]
);;

(* ----- fields *)

let field_sq_div_as_mul_div = prove(`
  !(k:K ring) rs g q.
  field k ==>
  rs IN ring_carrier k ==>
  g IN ring_carrier k ==>
  q IN ring_carrier k ==>
  ring_mul(k:K ring) (ring_div k rs (ring_pow k g 2)) (ring_pow k q 2) = ring_mul k (ring_div k rs (ring_mul k g g)) (ring_mul k q q)
`,
  FIELD_TAC
);;

let field_div_sq_mul_cancel = prove(`
  !(k:K ring) rs g q.
  field k ==>
  rs IN ring_carrier k ==>
  g IN ring_carrier k ==>
  q IN ring_carrier k ==>
  ring_mul k (ring_div k rs (ring_mul k g g)) (ring_mul k g q)
  = ring_mul k (ring_div k rs g) q
`,
  FIELD_TAC
);;

let field_mul_div_div_cancel = prove(`
  !(k:K ring) G B Aprime.
  field k ==>
  G IN ring_carrier k ==>
  B IN ring_carrier k ==>
  Aprime IN ring_carrier k ==>
  ~(G = ring_0 k) ==>
  ring_div k (ring_div k (ring_mul k G B) Aprime) G
  = ring_div k B Aprime
`,
  FIELD_TAC
);;

let prime_divides_binomial = prove(`
  !p i.
  prime p ==>
  0 < i ==>
  i < p ==>
  p divides binom (p,i)
`,
  intro THEN
  choose `d:num` `p = i + SUC d` [LT_EXISTS] THEN
  num_linear `p = i + SUC d ==> p = (d+1)+i` THEN
  specialize[`d+1`;`i:num`]BINOM_FACT THEN
  have `FACT p = FACT (d+1) * FACT i * binom (p,i)` [] THEN
  have `2 <= p` [PRIME_GE_2] THEN
  num_linear `2 <= p ==> p = SUC(p-1)` THEN
  have `FACT p = p * FACT(p-1)` [FACT] THEN
  have `p divides FACT p` [divides] THEN
  have `p divides (FACT (d+1) * FACT i * binom (p,i))` [] THEN
  num_linear `p = (d+1)+i ==> 0 < i ==> ~(p <= d+1)` THEN
  have `~(p divides FACT (d+1))` [DIVIDES_FACT_PRIME] THEN
  num_linear `p = (d+1)+i ==> ~(p <= i)` THEN
  have `~(p divides FACT i)` [DIVIDES_FACT_PRIME] THEN
  have `~(p divides (FACT (d+1) * FACT i))` [PRIME_DIVPROD] THEN
  qed[PRIME_DIVPROD]
);;

let freshman_binomial_theorem = prove(`
  !(r:R ring) p x y.
  ring_char r = p ==>
  prime p ==>
  x IN ring_carrier r ==>
  y IN ring_carrier r ==>
  ring_pow r (ring_add r x y) p
  = ring_add r (ring_pow r x p) (ring_pow r y p)
`,
  intro THEN
  have `2 <= p` [PRIME_GE_2] THEN
  def `s:num->R` `\k. ring_mul(r:R ring) (ring_of_num r (binom (p,k))) (ring_mul r (ring_pow r x k) (ring_pow r y (p - k)))` THEN
  have `ring_pow(r:R ring) (ring_add r x y) p = ring_sum r (0..p) s` [RING_BINOMIAL_THEOREM] THEN
  num_linear `2 <= p ==> SUC(p-1) = p` THEN
  num_linear `0 <= SUC(p-1)` THEN
  have `!k:num. s k IN ring_carrier(r:R ring)` [RING_MUL;RING_OF_NUM;RING_POW] THEN
  have `ring_sum(r:R ring) (0..SUC(p-1)) s = ring_add r (s (SUC(p-1))) (ring_sum r (0..p-1) s)` [RING_SUM_CLAUSES_NUMSEG_ALT] THEN
  have `ring_sum(r:R ring) (0..p) s = ring_add r (s p) (ring_sum r (0..p-1) s)` [] THEN
  num_linear `2 <= p ==> 0 <= p-1` THEN
  have `ring_sum(r:R ring) (0..p-1) s = ring_add r (s 0) (ring_sum r ((0+1)..p-1) s)` [RING_SUM_CLAUSES_LEFT] THEN
  num_linear `0 + 1 = 1` THEN
  have `ring_sum(r:R ring) (0..p-1) s = ring_add r (s 0) (ring_sum r (1..p-1) s)` [] THEN
  subgoal `!i. i IN 1..p-1 ==> s i = ring_0(r:R ring)` THENL [
    intro THEN
    have `1 <= i` [IN_NUMSEG] THEN
    have `i <= p-1` [IN_NUMSEG] THEN
    num_linear `1 <= i ==> 0 < i` THEN
    num_linear `2 <= p ==> i <= p-1 ==> i < p` THEN
    have `p divides binom (p,i)` [prime_divides_binomial] THEN
    have `ring_of_num(r:R ring) (binom (p,i)) = ring_0 r` [RING_OF_NUM_EQ_0] THEN
    have `ring_pow(r:R ring) x i IN ring_carrier r` [RING_POW] THEN
    have `ring_pow(r:R ring) y (p-i) IN ring_carrier r` [RING_POW] THEN
    have `ring_mul(r:R ring) (ring_pow r x i) (ring_pow r y (p-i)) IN ring_carrier r` [RING_MUL] THEN
    specialize[`r:R ring`;`ring_mul(r:R ring) (ring_pow r x i) (ring_pow r y (p - i))`]ring_0_mul THEN
    qed[]
  ; pass
  ] THEN
  have `ring_sum(r:R ring) (1..p-1) s = ring_0 r` [RING_SUM_EQ_0] THEN
  have `ring_sum(r:R ring) (0..p-1) s = s 0` [ring_add_0;RING_SUM] THEN
  have `ring_sum(r:R ring) (0..p) s = ring_add r (s p) (s 0)` [] THEN
  subgoal `s 0 = ring_pow(r:R ring) y p` THENL [
    simp[] THEN
    have `binom(p,0) = 1` [binom] THEN
    have `ring_of_num r (binom(p,0)) = ring_1(r:R ring)` [RING_OF_NUM_1] THEN
    have `ring_pow(r:R ring) x 0 = ring_1 r` [RING_POW_0] THEN
    have `ring_mul(r:R ring) (ring_pow r x 0) (ring_pow r y (p - 0)) = ring_pow r y (p - 0)` [ring_1_mul;RING_POW] THEN
    have `ring_mul(r:R ring) (ring_of_num r (binom (p,0))) (ring_pow r y (p - 0)) = ring_pow r y (p - 0)` [ring_1_mul;RING_POW] THEN
    qed[ARITH_RULE `p - 0 = p`]
  ; pass
  ] THEN
  subgoal `s p = ring_pow(r:R ring) x p` THENL [
    simp[] THEN
    have `binom(p,p) = 1` [BINOM_REFL] THEN
    have `ring_of_num(r:R ring) (binom(p,p)) = ring_1 r` [RING_OF_NUM_1] THEN
    have `ring_pow(r:R ring) y (p-p) = ring_1 r` [RING_POW_0;ARITH_RULE `p-p = 0`] THEN
    have `ring_mul(r:R ring) (ring_pow r x p) (ring_pow r y (p-p)) = ring_pow r x p` [ring_mul_1;RING_POW] THEN
    have `ring_mul(r:R ring) (ring_of_num r (binom (p,p))) (ring_pow r x p) = ring_pow r x p` [ring_1_mul;RING_POW] THEN
    qed[]
  ; pass
  ] THEN
  qed[]
);;
  
let freshman_binomial_theorem_sub = prove(`
  !(r:R ring) p x y.
  ring_char r = p ==>
  prime p ==>
  x IN ring_carrier r ==>
  y IN ring_carrier r ==>
  ring_pow r (ring_sub r x y) p
  = ring_sub r (ring_pow r x p) (ring_pow r y p)
`,
  intro THEN
  def `z:R` `ring_sub(r:R ring) x y` THEN
  have `z IN ring_carrier(r:R ring)` [RING_SUB] THEN
  have `ring_pow(r:R ring) (ring_add r z y) p = ring_add r (ring_pow r z p) (ring_pow r y p)` [freshman_binomial_theorem] THEN
  have `ring_add(r:R ring) z y = x` [RING_RULE `ring_add(r:R ring) (ring_sub r x y) y = x`] THEN
  qed[RING_RULE `X = ring_add(r:R ring) Z Y ==> Z = ring_sub r X Y`;RING_POW]
);;

let freshman_binomial_theorem_sub_eq = prove(`
  !(r:R ring) p x y.
  ring_char r = p ==>
  prime p ==>
  x IN ring_carrier r ==>
  y IN ring_carrier r ==>
  ring_pow r x p = ring_pow r y p ==>
  ring_pow r (ring_sub r x y) p = ring_0 r
`,
  qed[freshman_binomial_theorem_sub;RING_SUB_REFL;RING_POW]
);;

let domain_perfect_if_finite = prove(`
  !(k:K ring) a.
  integral_domain k ==>
  FINITE(ring_carrier k) ==>
  a IN ring_carrier k ==>
  ?b. b IN ring_carrier k /\ a = ring_pow k b (ring_char k)
`,
  intro THEN
  def `p:num` `ring_char(k:K ring)` THEN
  have `prime p` [INTEGRAL_DOMAIN_CHAR;RING_CHAR_FINITE] THEN
  def `f:K->K` `\x. ring_pow(k:K ring) x p` THEN
  subgoal `!x y:K. x IN ring_carrier k /\ y IN ring_carrier k /\ (f:K->K) x = f y ==> x = y` THENL [
    intro THEN
    have `ring_pow(k:K ring) (ring_sub k x y) p = ring_0 k` [freshman_binomial_theorem_sub_eq] THEN
    have `~(p = 0)` [PRIME_GE_2;ARITH_RULE `2 <= p ==> ~(p = 0)`] THEN
    have `ring_sub(k:K ring) x y = ring_0 k` [INTEGRAL_DOMAIN_POW_EQ_0;RING_SUB] THEN
    qed[RING_SUB_EQ_0]
  ; pass
  ] THEN
  subgoal `IMAGE (f:K->K) (ring_carrier k) SUBSET ring_carrier k` THENL [
    rw[SUBSET;IN_IMAGE] THEN
    qed[RING_POW]
  ; pass
  ] THEN
  specialize_raw[`ring_carrier(k:K ring)`;`f:K->K`]SURJECTIVE_IFF_INJECTIVE THEN
  qed[]
);;

let domain_perfect_if_finite_char2 = prove(`
  !(k:K ring) a.
  integral_domain k ==>
  FINITE(ring_carrier k) ==>
  ring_char k = 2 ==>
  a IN ring_carrier k ==>
  ?b. b IN ring_carrier k /\ a = ring_mul k b b
`,
  qed[domain_perfect_if_finite;RING_POW_2]
);;

let field_div_mul_cancel = prove(`
  !(k:K ring) a b.
  field k ==>
  a IN ring_carrier k ==>
  b IN ring_carrier k ==>
  ~(b = ring_0 k) ==>
  ring_mul k (ring_div k a b) b = a
`,
  FIELD_TAC
);;

let field_mul_mul_div_cancel = prove(`
  !(k:K ring) a b c.
  field k ==>
  a IN ring_carrier k ==>
  b IN ring_carrier k ==>
  c IN ring_carrier k ==>
  ~(b = ring_0 k) ==>
  ring_mul k b (ring_mul k (ring_div k c b) a)
  = ring_mul k c a
`,
  FIELD_TAC
);;

let freshman_binomial_theorem_sum = prove(`
  !(r:R ring) p f (S:X->bool).
  FINITE S ==>
  ring_char r = p ==>
  prime p ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  ring_pow r (ring_sum r S f) p
  = ring_sum r S (\s. ring_pow r (f s) p)
`,
  intro THEN
  specialize_raw[`r:R ring`;`\x xp:R. xp = ring_pow r x p`;`f:X->R`;`\s. ring_pow r ((f:X->R) s) p`;`S:X->bool`]RING_SUM_RELATED THEN
  have `~(p = 0)` [PRIME_GE_2;ARITH_RULE `2 <= p ==> ~(p = 0)`] THEN
  qed[RING_POW_ZERO;freshman_binomial_theorem;RING_POW]
);;

(* ----- co1, the most useful concept of coprimality *)

let ring_co1 = new_definition `
  ring_co1 (r:R ring) a b <=>
     a IN ring_carrier r
  /\ b IN ring_carrier r
  /\ ideal_generated r {a,b} = ring_carrier r
`;;

let ring_co1_sym = prove(`
  !(r:R ring) a b.
  ring_co1 r a b <=>
  ring_co1 r b a
`,
  intro THEN
  set_tac `{a,b}:R->bool = {b,a}` [] THEN
  qed[ring_co1]
);;

let ring_co1_add = prove(`
  !(r:R ring) a b.
  ring_co1 r a b <=>
  (   a IN ring_carrier r
   /\ b IN ring_carrier r
   /\ (?x y.
           x IN ring_carrier r
        /\ y IN ring_carrier r
        /\ ring_add r (ring_mul r a x) (ring_mul r b y) = ring_1 r
      )
  )
`,
  simp[ring_co1;IDEAL_GENERATED_2] THEN
  intro THEN
  EQ_TAC THEN
  intro THEN
  simp[] THENL [
    have `ring_1(r:R ring) IN ring_carrier r` [RING_1] THEN
    have `ring_1(r:R ring) IN { ring_add r (ring_mul r a x) (ring_mul r b y) | x,y | x IN ring_carrier r /\ y IN ring_carrier r}` [IDEAL_GENERATED_2] THEN
    set_tac `ring_1(r:R ring) IN { ring_add r (ring_mul r a x) (ring_mul r b y) | x,y | x IN ring_carrier r /\ y IN ring_carrier r} ==> ?x y. x IN ring_carrier r /\ y IN ring_carrier r /\ ring_add r (ring_mul r a x) (ring_mul r b y) = ring_1 r` [] THEN
    qed[]
  ;
    set_tac `x IN ring_carrier r /\ y IN ring_carrier r /\ ring_add r (ring_mul r a x) (ring_mul r b y) = ring_1 r ==> ring_1(r:R ring) IN { ring_add r (ring_mul r a x) (ring_mul r b y) | x,y | x IN ring_carrier r /\ y IN ring_carrier r}` [] THEN
    have `ring_1 r IN ideal_generated(r:R ring) {a,b}` [IDEAL_GENERATED_2] THEN
    have `ring_ideal(r:R ring) (ideal_generated r {a,b})` [RING_IDEAL_IDEAL_GENERATED] THEN
    qed[RING_IDEAL_EQ_CARRIER]
  ]
);;

let ring_co1_sub = prove(`
  !(r:R ring) a b.
  ring_co1 r a b <=>
  (   a IN ring_carrier r
   /\ b IN ring_carrier r
   /\ (?x y.
           x IN ring_carrier r
        /\ y IN ring_carrier r
        /\ ring_sub r (ring_mul r a x) (ring_mul r b y) = ring_1 r
      )
  )
`,
  intro THEN
  rw[ring_co1_add] THEN
  EQ_TAC THEN
  simp[] THEN
  intro THEN
  EXISTS_TAC `x:R` THEN
  EXISTS_TAC `ring_neg r (y:R)` THEN
  simp[RING_NEG] THEN
  RING_TAC
);;

let ring_divides_if_divides_mul_co1_add = prove(`
  !(r:R ring) a b c u v.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  c IN ring_carrier r ==>
  u IN ring_carrier r ==>
  v IN ring_carrier r ==>
  ring_divides r a (ring_mul r b c) ==>
  ring_add r (ring_mul r a u) (ring_mul r b v) = ring_1 r ==>
  ring_divides r a c
`,
  intro THEN
  choose `d:R` `d IN ring_carrier r /\ ring_mul(r:R ring) a d = ring_mul r b c` [ring_divides] THEN
  simp[ring_divides] THEN
  EXISTS_TAC `ring_add(r:R ring) (ring_mul r u c) (ring_mul r v d)` THEN
  simp[RING_MUL;RING_ADD] THEN
  qed[RING_RULE `ring_add r (ring_mul r a u) (ring_mul r b v) = ring_1 r ==> ring_mul r a d = ring_mul r b c ==> c = ring_mul r a (ring_add r (ring_mul r u c) (ring_mul r v d))`]
);;

let ring_divides_if_divides_mul_co1 = prove(`
  !(r:R ring) a b c.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  c IN ring_carrier r ==>
  ring_co1 r a b ==>
  ring_divides r a (ring_mul r b c) ==>
  ring_divides r a c
`,
  rw[ring_co1_add] THEN
  qed[ring_divides_if_divides_mul_co1_add]
);;

(* ----- exponent vectors *)

let map0to = new_definition `
  map0to (d:num) = \v. if v = 0 then d else 0
`;;

let map0to_0_monomial_1 = prove(`
  map0to 0 = monomial_1
`,
  rw[map0to;monomial_1;COND_ID]
);;

let map0to_add = prove(`
  !a b.
  monomial_mul (map0to a) (map0to b) = map0to (a+b)
`,
  rw[monomial_mul;map0to;FUN_EQ_THM] THEN
  qed[ARITH_RULE `0+0 = 0`]
);;

let map0to_injective = prove(`
  !d e.
  map0to d = map0to e ==> 
  d = e
`,
  rw[map0to] THEN
  intro THEN
  have `(\v. if v = 0 then d else 0) 0 = (\v. if v = 0 then e else 0) 0` [] THEN
  qed[]
);;

let ring_sum_image_map0to = prove(`
  !(r:A ring) (g:(num->num)->A) s.
  ring_sum r (IMAGE map0to s) g = ring_sum r s (g o map0to)
`,
  qed[map0to_injective;RING_SUM_IMAGE]
);;

let map0to_pair_injective = prove(`
  !(a,b) (c,d).
  (\(a,b). map0to a,map0to b) (a,b) = (\(a,b). map0to a,map0to b) (c,d) ==>
  (a,b) = (c,d)
`,
  rw[FORALL_PAIRED_THM] THEN
  intro THEN
  have `map0to a = map0to c` [FST] THEN
  have `map0to b = map0to d` [SND] THEN
  qed[map0to_injective]
);;

(* not sure why specialize fails here while ASSUME_TAC works *)
let ring_sum_image_map0to_pair = prove(`
  !(r:A ring) (g:(num->num)#(num->num)->A) (s:num#num->bool).
  ring_sum r (IMAGE (\(a,b). map0to a,map0to b) s) g
  = ring_sum r s (g o (\(a,b). map0to a,map0to b))
`,
  intro THEN
  have `!(a,b) (c,d):num#num. (\(a,b). map0to a,map0to b) (a,b) = (\(a,b). map0to a,map0to b) (c,d) ==> (a,b) = (c,d)` [map0to_pair_injective] THEN
  ASSUME_TAC(ISPECL[`r:A ring`;`\(a,b):num#num. map0to a,map0to b`;`g:(num->num)#(num->num)->A`;`s:(num#num)->bool`]ring_sum_image_injective_pair) THEN
  qed[]
);;

let finite_image_map0to_eq = prove(`
  !s.
  FINITE(IMAGE map0to s) <=> FINITE s
`,
  qed[map0to_injective;FINITE_IMAGE_INJ_EQ]
);;

let supported_on_0_implies_map0to = prove(`
  !e:num->num.
  {v | ~(e v = 0)} SUBSET {0} ==>
  e = map0to (e 0)
`,
  rw[map0to;SUBSET;IN_ELIM_THM;IN_SING] THEN
  intro THEN
  sufficesby EQ_EXT THEN
  qed[]
);;

let map0to_support = prove(`
  !d.
  {v | ~(map0to d v = 0)} = if d = 0 then {} else {0}
`,
  rw[map0to;EXTENSION] THEN
  intro THEN
  splitcases `d = 0` [
    simp[in_empty;IN_ELIM_THM] THEN
    qed[]
  ;
    simp[IN_SING;IN_ELIM_THM] THEN
    qed[]
  ]
);;

let map0to_monomial_vars = prove(`
  !d.
  monomial_vars (map0to d) = if d = 0 then {} else {0}
`,
  rw[monomial_vars] THEN
  qed[map0to_support]
);;

let map0to_monomial_vars_finite = prove(`
  !d.
  FINITE (monomial_vars (map0to d))
`,
  rw[map0to_monomial_vars] THEN
  qed[FINITE_SING;FINITE_EMPTY]
);;

(* ----- x_ring, the ring of univariate polynomials *)

let x_ring = new_definition `
  x_ring (r:R ring) = poly_ring r {0}
`;;

let x_ring_domain = prove(`
  !(r:A ring).
  integral_domain(x_ring r) <=> integral_domain r
`,
  qed[x_ring;INTEGRAL_DOMAIN_POLY_RING]
);;

let x_ring_0 = prove(`
  !r:A ring.
  ring_0(x_ring r) = poly_0(r)
`,
  rw[x_ring;POLY_RING]
);;

let x_ring_1 = prove(`
  !r:A ring.
  ring_1(x_ring r) = poly_1(r)
`,
  rw[x_ring;POLY_RING]
);;

let x_ring_neg = prove(`
  !r:A ring.
  ring_neg(x_ring r) = poly_neg(r)
`,
  rw[x_ring;POLY_RING]
);;

let x_ring_add = prove(`
  !r:A ring.
  ring_add(x_ring r) = poly_add(r)
`,
  rw[x_ring;POLY_RING]
);;

let x_ring_mul = prove(`
  !r:A ring.
  ring_mul(x_ring r) = poly_mul(r)
`,
  rw[x_ring;POLY_RING]
);;

let poly_const_in_x_ring = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  poly_const r c IN ring_carrier(x_ring r)
`,
  rw[x_ring] THEN
  qed[POLY_CONST]
);;

let poly_const_sum_o = prove(`
  !(r:A ring) S (f:X->A).
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  poly_const r (ring_sum r S f)
  = ring_sum(x_ring r) S ((poly_const r) o f)
`,
  intro THEN
  have `ring_homomorphism((r:A ring),x_ring r) (poly_const r)` [RING_HOMOMORPHISM_POLY_CONST;x_ring] THEN
  qed[RING_HOMOMORPHISM_SUM]
);;

let poly_const_sum = prove(`
  !(r:A ring) S (f:X->A).
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  poly_const r (ring_sum r S f)
  = ring_sum(x_ring r) S (\s. poly_const r (f s))
`,
  intro THEN
  have_eqlambda `(poly_const(r:A ring):A->(num->num)->A) o (f:X->A) = (\s. poly_const r (f s))` [o_DEF] THEN
  qed[poly_const_sum_o]
);;

let poly_ring_carrier = prove(`
  !r:A ring. !s:V->bool. ring_carrier(poly_ring r s) = {p | ring_polynomial r p /\ poly_vars r p SUBSET s}
`,
  qed[POLY_RING]
);;

let x_ring_carrier = prove(`
  !r:A ring. ring_carrier(x_ring r) = {p | ring_polynomial r p /\ poly_vars r p SUBSET {0}}
`,
  GEN_TAC THEN
  rw[x_ring] THEN
  specialize[`r:A ring`;`{0}`]poly_ring_carrier THEN
  qed[]
);;

let in_x_ring_carrier_implies_polynomial = prove(`
  !r:A ring. !p.
  p IN ring_carrier(x_ring r) ==> 
  ring_polynomial r p
`,
  SET_TAC[x_ring_carrier]
);;

let in_x_ring_carrier_implies_powerseries = prove(`
  !r:A ring. !p.
  p IN ring_carrier(x_ring r) ==> 
  ring_powerseries r p
`,
  qed[in_x_ring_carrier_implies_polynomial;RING_POLYNOMIAL_IMP_POWERSERIES]
);;

let in_x_ring_carrier_implies_poly_vars_subset_0 = prove(`
  !r:A ring. !p.
  p IN ring_carrier(x_ring r) ==> 
  poly_vars r p SUBSET {0}
`,
  SET_TAC[x_ring_carrier]
);;

let in_x_ring_carrier_implies_monomial_var_subset_0_lemma = prove(`
  !r:A ring. !p. !m.
  poly_vars r p SUBSET {0} ==>
  ~(p m = ring_0 r) ==>
  monomial_vars m SUBSET {0}
`,
  rw[poly_vars] THEN
  SET_TAC[]
);;

let in_x_ring_carrier_implies_monomial_var_subset_0 = prove(`
  !r:A ring. !p. !m.
  p IN ring_carrier(x_ring r) ==> 
  ~(p m = ring_0 r) ==>
  monomial_vars m SUBSET {0}
`,
  intro THEN
  have `poly_vars (r:A ring) p SUBSET {0}` [in_x_ring_carrier_implies_poly_vars_subset_0] THEN
  qed[in_x_ring_carrier_implies_monomial_var_subset_0_lemma]
);;

let x_ring_of_num = prove(`
  !(r:R ring) n.
  ring_of_num(x_ring r) n
  = poly_const r (ring_of_num r n)
`,
  GEN_TAC THEN INDUCT_TAC THEN
  rw[ring_of_num] THENL [
    qed[x_ring_0;poly_0]
  ;
    rw[POLY_CONST_ADD] THEN
    qed[x_ring_add;x_ring_1;poly_1]
  ]
);;

let x_ring_char = prove(`
  !(r:R ring).
  ring_char(x_ring r) = ring_char r
`,
  rw[RING_CHAR_UNIQUE] THEN
  rw[x_ring_of_num] THEN
  rw[x_ring_0;poly_0] THEN
  rw[POLY_CONST_EQ] THEN
  qed[RING_CHAR_UNIQUE]
);;

let poly_const_sub = prove(`
  !(r:R ring) x y.
  x IN ring_carrier r ==>
  y IN ring_carrier r ==>
  poly_const r (ring_sub r x y) =
  ring_sub(x_ring r) (poly_const r x) (poly_const r y)
`,
  intro THEN
  have `ring_sub(r:R ring) x y IN ring_carrier r` [RING_SUB] THEN
  have `ring_add(r:R ring) (ring_sub r x y) y = x` [RING_RULE `ring_add(r:R ring) (ring_sub r x y) y = x`] THEN
  have `poly_const(r:R ring) (ring_add r (ring_sub r x y) y) = ring_add(x_ring r) (poly_const r (ring_sub r x y)) (poly_const r y)` [POLY_CONST_ADD;x_ring_add] THEN
  have `poly_const(r:R ring) x = ring_add(x_ring(r:R ring)) (poly_const r (ring_sub r x y)) (poly_const r y)` [] THEN
  qed[poly_const_in_x_ring;RING_RULE `a = ring_add(r:R ring) b c ==> b = ring_sub r a c`]
);;

(* ----- powers of x *)

let x_pow = new_definition `
  x_pow (r:R ring) (d:num) =
  \m. if m = map0to d then ring_1 r else ring_0 r
`;;

let x_pow_nonzero = prove(`
  !(r:A ring) d.
  ~(ring_1 r = ring_0 r) ==>
  ~(x_pow r d = poly_0 r)
`,
  intro_genonly THEN DISCH_TAC THEN
  rw[x_pow;map0to;poly_0;POLY_CONST_0;FUN_EQ_THM;NOT_FORALL_THM] THEN
  EXISTS_TAC `\v. if v = 0 then d else 0` THEN
  simp[]
);;

let x_pow_0 = prove(`
  !r:A ring.
  x_pow r 0 = poly_1 r
`,
  rw[x_pow;map0to;poly_1;poly_const;monomial_1;COND_ID]
);;

let x_pow_is_powerseries = prove(`
  !r:A ring. !d.
  ring_powerseries r (x_pow r d)
`,
  rw[ring_powerseries;x_pow] THEN
  intro_genonly THEN
  conjunction [
    STRIP_TAC THEN
    rw[map0to] THEN
    qed[RING_1;RING_0];
    qed[INFINITE;map0to_monomial_vars_finite]
  ]
);;

let x_pow_monomial_support = prove(`
  !r:A ring. !d.
  {m | ~(x_pow r d m = ring_0 r)}
  = if ring_1 r = ring_0 r then {} else {map0to d}
`,
  rw[x_pow] THEN
  intro_genonly THEN
  splitcases `ring_1 r = ring_0 (r:A ring)` [
    simp[] THEN
    SET_TAC[];
    simp[] THEN
    rw[EXTENSION;IN_ELIM_THM;IN_SING] THEN
    qed[]
  ]
);;

let x_pow_is_poly = prove(`
  !r:A ring. !d.
  ring_polynomial r (x_pow r d)
`,
  rw[ring_polynomial] THEN
  intro_genonly THEN
  conjunction [
    qed[x_pow_is_powerseries]
  ;
    have `FINITE {map0to d}` [FINITE_SING] THEN
    have `FINITE ({}:(num->num)->bool)` [FINITE_EMPTY] THEN
    have `{m | ~(x_pow r d m = ring_0 (r:A ring))} = if ring_1 r = ring_0 r then {} else {map0to d}` [x_pow_monomial_support] THEN
    qed[]
  ]
);;

let x_pow_vars = prove(`
  !r:A ring. !d.
  poly_vars r (x_pow r d)
  = if ring_1 r = ring_0 r
    then {}
    else if d = 0 then {} else {0}
`,
  rw[poly_vars] THEN
  once_rw[SIMPLE_IMAGE_GEN] THEN
  rw[x_pow_monomial_support] THEN
  intro_genonly THEN
  splitcases `ring_1 r = ring_0 (r:A ring)` [
    simp[] THEN
    rw[image_empty;UNIONS_0];
    simp[] THEN
    rw[image_sing;map0to_monomial_vars;UNIONS_1]
  ]
);;

let x_pow_vars_subset_0 = prove(`
  !r:A ring. !d.
  poly_vars r (x_pow r d) SUBSET {0}
`,
  rw[x_pow_vars] THEN
  intro_genonly THEN
  SET_TAC[]
);;

let x_pow_in_x_ring = prove(`
  !r:A ring. !d.
  x_pow r d IN ring_carrier(x_ring r)
`,
  rw[x_ring;POLY_RING;IN_ELIM_THM] THEN
  intro_genonly THEN
  conjunction [
    qed[x_pow_is_poly];
    qed[x_pow_vars_subset_0]
  ]
);;

(* ----- the polynomial x *)

let poly_x = new_definition `
  poly_x (r:R ring) = x_pow r 1
`;;

let x_in_x_ring = prove(`
  !r:A ring.
  poly_x r IN ring_carrier(x_ring r)
`,
  rw[poly_x;x_pow_in_x_ring]
);;

let poly_var_0_is_x = prove(`
  !r:A ring.
  poly_var r 0 = poly_x r
`,
  rw[poly_var;monomial_var;poly_x;x_pow;map0to]
);;

let x_then_pow_is_x_pow = prove(`
  !r:A ring. !d.
  ring_pow(x_ring r) (poly_x r) d = x_pow r d
`,
  rw[x_ring;GSYM poly_var_0_is_x;POLY_RING_VAR_POW;x_pow;map0to]
);;

let poly_var_0_pow_map0to_0_is_x_pow = prove(`
  !r:A ring. !d.
  ring_pow(x_ring r) (poly_var r 0) (map0to d 0) = x_pow r d
`,
  rw[poly_var_0_is_x;x_then_pow_is_x_pow;map0to]
);;

(* ----- const_x_pow *)

let const_x_pow = new_definition `
  const_x_pow (r:R ring) c d =
    poly_mul(r) (poly_const r c) (x_pow r d)
`;;

(* maybe this is better as definition *)
let const_x_pow_expand = prove(`
  !(r:A ring) c:A d:num.
  c IN ring_carrier r ==>
  const_x_pow r c d =
  \m. if m = map0to d then c else ring_0 r
`,
  intro THEN
  rw[const_x_pow] THEN
  have `x_pow (r:A ring) d IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  have `ring_powerseries r (x_pow (r:A ring) d)` [in_x_ring_carrier_implies_powerseries] THEN
  simp[poly_const_mul_expand] THEN
  rw[x_pow] THEN
  once_rw[FUN_EQ_THM] THEN
  simp[] THEN
  GEN_TAC THEN
  splitcases `x = map0to d` [
    simp[] THEN
    RING_TAC
  ;
    simp[] THEN
    RING_TAC
  ]
);;

let const_x_pow_in_x_ring = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  const_x_pow r c d IN ring_carrier(x_ring r)
`,
  intro THEN
  rw[const_x_pow] THEN
  have `poly_const (r:A ring) c IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `x_pow (r:A ring) d IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  specialize[`x_ring(r:A ring)`;`(poly_const (r:A ring) c):(num->num)->A`;`x_pow (r:A ring) d`]RING_MUL THEN
  have `poly_mul r = ring_mul (x_ring (r:A ring))` [x_ring_mul] THEN
  qed[]
);;

let const_x_pow_add = prove(`
  !(r:A ring) b c d.
  b IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_add(r) (const_x_pow r b d) (const_x_pow r c d)
  = const_x_pow r (ring_add r b c) d
`,
  intro THEN
  have `ring_add r b c IN ring_carrier (r:A ring)` [RING_ADD] THEN
  simp[const_x_pow_expand;poly_add] THEN
  once_rw[FUN_EQ_THM] THEN
  GEN_TAC THEN
  simp[] THEN
  splitcases `x = map0to d` [
    simp[]
  ;
    simp[] THEN
    RING_TAC
  ]
);;

(* some redundancy with poly_const_mul_expand_lemma proof *)
let const_x_pow_mul_lemma = prove(`
  !(r:A ring) a:A b:num c:A d:num (m:num->num).
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  {m1m2 | m1m2 IN {m1,m2 | monomial_mul m1 m2 = m}
          /\ ~((\ (m1,m2). ring_mul r (if m1 = map0to b then a else ring_0 r) (if m2 = map0to d then c else ring_0 r)) m1m2 = ring_0 r)}
  = if m = map0to (b+d) then
      if ring_mul r a c = ring_0 r
      then {}
      else {(map0to b,map0to d)}
    else {}
`,
  intro THEN
  rw[EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  forwardreverse [
    intro THEN
    havetac `(\(m1,m2). ring_mul (r:A ring) (if m1 = map0to b then a else ring_0 r) (if m2 = map0to d then c else ring_0 r)) x = ring_mul r (if m1 = map0to b then a else ring_0 r) (if m2 = map0to d then c else ring_0 r)` (simp[]) THEN
    have `~(ring_mul (r:A ring) (if m1 = map0to b then a else ring_0 r) (if m2 = map0to d then c else ring_0 r) = ring_0 r)` [] THEN
    havetac `~(ring_mul (r:A ring) (if m1 = map0to b then a else ring_0 r) (if m2 = map0to d then c else ring_0 r) = ring_0 r)` (simp[]) THEN
    splitcases `m1 = map0to b` [
      splitcases `m2 = map0to d` [
        have `m = map0to (b+d)` [map0to_add] THEN
        have `~(ring_mul (r:A ring) a c = ring_0 r)` [] THEN
        simp[] THEN
        qed[IN_SING];
        qed[ring_mul_0]
      ];
      splitcases `m2 = map0to d` [
        simp[] THEN
        qed[ring_0_mul];
        qed[ring_0_mul;RING_0]
      ]
    ];
    handlecase `ring_mul (r:A ring) a c = ring_0 r` (
      qed[in_empty]
    ) THEN
    handlecase `m = map0to (b+d)` (
      simp[] THEN
      rw[IN_SING] THEN
      STRIP_TAC THEN
      conjunction [
        EXISTS_TAC `map0to b` THEN
        EXISTS_TAC `map0to d` THEN
        qed[map0to_add];
        simp[]
      ]
    ) THEN
    qed[in_empty]
  ]
);;

(* some redundancy with poly_const_mul_expand proof *)
let const_x_pow_mul = prove(`
  !(r:A ring) a:A b:num c:A d:num.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_mul(r) (const_x_pow r a b) (const_x_pow r c d)
  = const_x_pow r (ring_mul r a c) (b+d)
`,
  intro THEN
  have `ring_mul r a c IN ring_carrier(r:A ring)` [RING_MUL] THEN
  simp[poly_mul;const_x_pow_expand] THEN
  once_rw[FUN_EQ_THM] THEN
  intro THEN
  simp[] THEN
  once_rw[GSYM RING_SUM_SUPPORT] THEN
  simp[const_x_pow_mul_lemma] THEN
  handlecase `ring_mul(r:A ring) a c = ring_0 r` (
    simp[COND_ID;RING_SUM_CLAUSES]
  ) THEN
  handlecase `x = map0to(b+d)` (
    simp[] THEN
    rw[RING_SUM_SING] THEN
    qed[]
  ) THEN
  simp[COND_ID;RING_SUM_CLAUSES]
);;

let const_x_pow_deg0 = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  const_x_pow r c 0 = poly_const r c
`,
  intro THEN
  simp[const_x_pow_expand;poly_const;map0to_0_monomial_1]
);;

let const_x_pow_0 = prove(`
  !(r:A ring) d.
  const_x_pow r (ring_0 r) d = poly_0 r
`,
  intro THEN
  have `ring_0 (r:A ring) IN ring_carrier r` [RING_0] THEN
  simp[const_x_pow_expand;poly_0;poly_const;COND_ID]
);;

let const_x_pow_1 = prove(`
  !(r:A ring) d.
  const_x_pow r (ring_1 r) d = x_pow r d
`,
  intro THEN
  have `ring_1 (r:A ring) IN ring_carrier r` [RING_1] THEN
  simp[const_x_pow_expand;x_pow;map0to]
);;

let const_x_pow_nonzero = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  ~(c = ring_0 r) ==>
  ~(const_x_pow r c d = poly_0 r)
`,
  intro_genonly THEN DISCH_TAC THEN DISCH_TAC THEN
  simp[const_x_pow_expand;map0to;poly_0;POLY_CONST_0;FUN_EQ_THM;NOT_FORALL_THM] THEN
  EXISTS_TAC `\v. if v = 0 then d else 0` THEN
  simp[]
);;

let const_x_pow_sum = prove(`
  !(r:R ring) d f (S:X->bool).
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  const_x_pow r (ring_sum r S f) d
  = ring_sum(x_ring r) S (\s. const_x_pow r (f s) d)
`,
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    rw[RING_SUM_CLAUSES] THEN
    qed[const_x_pow_0;x_ring_0]
  ; pass
  ] THEN
  have `!s:X. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN
  have `!s:X. s IN S ==> f s IN ring_carrier(r:R ring)` [] THEN
  have `x:X IN x INSERT S` [IN_INSERT] THEN
  have `const_x_pow(r:R ring) (f (x:X)) d IN ring_carrier(x_ring r)` [const_x_pow_in_x_ring] THEN
  simp[RING_SUM_CLAUSES] THEN
  simp[GSYM const_x_pow_add;RING_SUM;x_ring_add]
);;

let sum_const_x_pow_samedeg_waterfall = prove(`
  !(r:R ring) (S:X->bool).
  FINITE S ==>
  !f d.
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  const_x_pow r (ring_sum r S f) d
  = ring_sum(x_ring r) S (\s. const_x_pow r (f s) d)
`,
  GEN_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    simp[RING_SUM_CLAUSES;const_x_pow_0;x_ring_0]
  ;
    have `(f:X->R) x IN ring_carrier r` [IN_INSERT] THEN
    have `const_x_pow(r:R ring) ((f:X->R) x) d IN ring_carrier(x_ring r)` [const_x_pow_in_x_ring] THEN
    have `ring_sum(r:R ring) (S:X->bool) f IN ring_carrier r` [RING_SUM] THEN
    simp[RING_SUM_CLAUSES;GSYM const_x_pow_add;x_ring_add] THEN
    have `!s:X. s IN S ==> f s IN ring_carrier(r:R ring)` [IN_INSERT] THEN
    qed[]
  ]
);;

let sum_const_x_pow_samedeg = prove(`
  !(r:R ring) (S:X->bool) f d.
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  const_x_pow r (ring_sum r S f) d
  = ring_sum(x_ring r) S (\s. const_x_pow r (f s) d)
`,
  simp[sum_const_x_pow_samedeg_waterfall]
);;

let x_pow_mul_const_x_pow = prove(`
  !(r:A ring) b:num c:A d:num.
  c IN ring_carrier r ==>
  poly_mul(r) (x_pow r b) (const_x_pow r c d)
  = const_x_pow r c (b+d)
`,
  intro THEN
  rw[GSYM const_x_pow_1] THEN
  qed[const_x_pow_mul;RING_1;ring_1_mul]
);;

let x_mul_const_x_pow = prove(`
  !(r:A ring) c:A d:num.
  c IN ring_carrier r ==>
  poly_mul(r) (poly_x r) (const_x_pow r c d)
  = const_x_pow r c (d+1)
`,
  rw[poly_x] THEN
  qed[x_pow_mul_const_x_pow;ADD_SYM]
);;

let poly_const_mul_const_x_pow = prove(`
  !(r:A ring) a:A c:A d:num.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_mul(r) (poly_const r a) (const_x_pow r c d)
  = const_x_pow r (ring_mul r a c) d
`,
  intro THEN
  simp[GSYM const_x_pow_deg0] THEN
  simp[const_x_pow_mul] THEN
  simp[ARITH_RULE `0 + d = d`]
);;

let x_pow_mul = prove(`
  !(r:A ring) b:num d:num.
  poly_mul(r) (x_pow r b) (x_pow r d)
  = x_pow r (b+d)
`,
  rw[GSYM const_x_pow_1] THEN
  simp[RING_1;const_x_pow_mul] THEN
  qed[RING_1;ring_1_mul]
);;

let const_x_pow_pow = prove(`
  !(r:A ring) a:A b:num d:num.
  a IN ring_carrier r ==>
  ring_pow(x_ring r) (const_x_pow r a b) d
  = const_x_pow r (ring_pow r a d) (b*d)
`,
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  INDUCT_TAC THENL [
    intro THEN
    rw[RING_POW_0] THEN
    rw[ARITH_RULE `b * 0 = 0`] THEN
    simp[const_x_pow_deg0;RING_1;x_ring_1;poly_1]
  ;
    intro THEN
    simp[ring_pow] THEN
    rw[x_ring_mul] THEN
    simp[const_x_pow_mul;RING_POW] THEN
    qed[ARITH_RULE `b * SUC d = b+b*d`]
  ]
);;

let const_x_pow_monomials_lemma = prove(`
  !(r:A ring) c d m.
  c IN ring_carrier r ==>
  ~(const_x_pow r c d m = ring_0 r) ==>
  m = map0to d
`,
  simp[const_x_pow_expand] THEN
  intro THEN
  qed[]
);;

let const_x_pow_monomials = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  {m | ~(const_x_pow r c d m = ring_0 r)} SUBSET {map0to d}
`,
  rw[SUBSET;IN_ELIM_THM;IN_SING] THEN
  qed[const_x_pow_monomials_lemma]
);;

(* ----- coefficients of polynomials *)

let coeff = new_definition `
  coeff (d:num) (p:(num->num)->R)
  = p(map0to d)
`;;

let coeff_in_ring = prove(`
  !(r:A ring) d p.
  p IN ring_carrier(x_ring r) ==>
  coeff d p IN ring_carrier(r)
`,
  rw[coeff;x_ring;POLY_RING;ring_polynomial;ring_powerseries] THEN
  SET_TAC[]
);;

let coeff_0 = prove(`
  !(r:A ring) d.
  coeff d (poly_0 r) = ring_0 r
`,
  rw[coeff;poly_0;poly_const] THEN
  qed[]
);;

let coeff_neg_poly = prove(`
  !(r:A ring) d p.
  coeff d (poly_neg r p)
  = ring_neg r (coeff d p)
`,
  rw[coeff;poly_neg] THEN
  qed[]
);;

let coeff_neg = prove(`
  !(r:A ring) d p.
  coeff d (ring_neg(x_ring r) p)
  = ring_neg r (coeff d p)
`,
  qed[x_ring;POLY_RING;coeff_neg_poly]
);;

let coeff_add_poly = prove(`
  !(r:A ring) d p q.
  coeff d (poly_add r p q)
  = ring_add r (coeff d p) (coeff d q)
`,
  rw[coeff;poly_add] THEN
  qed[]
);;

let coeff_add = prove(`
  !(r:A ring) d p q.
  coeff d (ring_add(x_ring r) p q)
  = ring_add r (coeff d p) (coeff d q)
`,
  qed[x_ring;POLY_RING;coeff_add_poly]
);;

let coeff_sub = prove(`
  !(r:A ring) d p q.
  coeff d (ring_sub(x_ring r) p q)
  = ring_sub r (coeff d p) (coeff d q)
`,
  rw[ring_sub] THEN
  qed[coeff_neg;coeff_add]
);;

let coeff_sub_eq_0 = prove(`
  !(r:R ring) d p q.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  (coeff d (ring_sub(x_ring r) p q) = ring_0 r
   <=> coeff d p = coeff d q)
`,
  rw[coeff_sub] THEN
  qed[RING_SUB_EQ_0;coeff_in_ring]
);;

let coeff_sum_o = prove(`
  !(r:R ring) d (f:X->(num->num)->R) S.
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  coeff d (ring_sum(x_ring r) S f)
  = ring_sum r S (coeff d o f)
`,
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    simp[RING_SUM_CLAUSES] THEN
    qed[x_ring_0;coeff_0]
  ;
    have `(x:X) IN x INSERT S` [IN_INSERT] THEN
    have `f(x:X) IN ring_carrier(x_ring(r:R ring))` [] THEN
    have `(coeff d o f) (x:X) IN ring_carrier(r:R ring)` [o_THM;coeff_in_ring] THEN
    have `!s:X. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN
    have `!s:X. s IN S ==> f s IN ring_carrier(x_ring(r:R ring))` [] THEN
    have `coeff d (f(x:X)):R = (coeff d o f) x` [o_THM] THEN
    simp[RING_SUM_CLAUSES;coeff_add]
  ]
);;

let coeff_mul_poly_lemma1 = prove(`
  !d (m:num->num) (n:num->num).
  monomial_mul m n = map0to d ==>
  ?a b. a + b = d /\ m = map0to a /\ n = map0to b
`,
  rw[monomial_mul;map0to] THEN
  intro THEN
  EXISTS_TAC `m 0:num` THEN
  EXISTS_TAC `n 0:num` THEN
  conjunction [
    qed[]
  ;
    rw[FUN_EQ_THM;AND_FORALL_THM] THEN
    GEN_TAC THEN
    splitcases `x = 0` [
      simp[]
    ;
      simp[] THEN
      have `m (x:num) + n x = 0` [] THEN
      qed[ADD_EQ_0]
    ]
  ]
);;

let coeff_mul_poly_lemma2 = prove(`
  !d.
  {m,n:num->num | monomial_mul m n = map0to d}
  = IMAGE (\(a,b). map0to a,map0to b) {a,b | a+b = d}
`,
  rw[image_pair;EXTENSION] THEN
  intro_genonly THEN
  forwardreverse [
    rw[IN_ELIM_THM] THEN
    STRIP_TAC THEN
    have `?a b. a + b = d /\ m = map0to a /\ n = map0to b` [coeff_mul_poly_lemma1] THEN
    qed[]
  ;
    rw[IN_ELIM_THM] THEN
    STRIP_TAC THEN
    EXISTS_TAC `map0to a` THEN
    EXISTS_TAC `map0to b` THEN
    qed[map0to_add]
  ]
);;

let coeff_mul_poly_lemma3 = prove(`
  !(r:A ring) p q.
  ((\(m1,m2). ring_mul r (p m1) (q m2)) o (\(a,b). map0to a,map0to b)) =
  (\(a,b). ring_mul r (p (map0to a)) (q (map0to b)))
`,
  rw[FUN_EQ_THM] THEN
  intro_genonly THEN
  choose `a:num` `?b. x = (a:num),(b:num)` [PAIR_SURJECTIVE] THEN
  choose `b:num` `x = (a:num),(b:num)` [] THEN
  simp[o_THM]
);;

let coeff_mul_poly = prove(`
  !(r:A ring) d p q.
  coeff d (poly_mul r p q)
  = ring_sum(r) {a,b | a+b = d} (\(a,b). ring_mul r (coeff a p) (coeff b q))
`,
  rw[poly_mul;coeff;coeff_mul_poly_lemma2;ring_sum_image_map0to_pair;coeff_mul_poly_lemma3]
);;

let coeff_mul_poly_oneindex = prove(`
  !(r:A ring) d p q.
  coeff d (poly_mul r p q)
  = ring_sum(r) {a | a <= d} (\a. ring_mul r (coeff a p) (coeff (d-a) q))
`,
  intro THEN
  rw[coeff_mul_poly] THEN
  def `f:num->(num#num)` `\a:num. a,d-a` THEN
  have `!a b:num. (f:num->num#num) a = f b ==> a = b` [FST] THEN
  have `ring_sum r (IMAGE (f:num->num#num) {a | a <= d}) (\(a,b). ring_mul r (coeff a p) (coeff b q)) = ring_sum(r:A ring) {a | a <= d} ((\(a,b). ring_mul r (coeff a p) (coeff b q)) o f)` [RING_SUM_IMAGE] THEN
  have `IMAGE (f:num->num#num) {a | a <= d} = {a,b | a + b = d}` [image_numseg_antidiagonal] THEN
  ASSUME_TAC(prove(`(\(a,b). ring_mul(r:A ring) (coeff a p) (coeff b q)) o (\a. a,d-a) = (\a. ring_mul r (coeff a p) (coeff (d-a) q))`,rw[FUN_EQ_THM;o_THM])) THEN
  qed[]
);;

let coeff_mul_poly_deg0 = prove(`
  !(r:R ring) p q.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  coeff 0 (poly_mul r p q)
  = ring_mul r (coeff 0 p) (coeff 0 q)
`,
  rw[coeff_mul_poly_oneindex] THEN
  intro THEN
  have `coeff 0 p IN ring_carrier(r:R ring)` [coeff_in_ring] THEN
  have `coeff 0 q IN ring_carrier(r:R ring)` [coeff_in_ring] THEN
  have `ring_mul r (coeff 0 p) (coeff 0 q) IN ring_carrier(r:R ring)` [RING_MUL] THEN
  subgoal `{a:num | a <= 0} = {0}` THENL [
    rw[EXTENSION;IN_SING;IN_ELIM_THM] THEN
    ARITH_TAC
  ; pass
  ] THEN
  simp[RING_SUM_SING;ARITH_RULE `0-0 = 0`]
);;

let coeff_const_x_pow = prove(`
  !(r:A ring) c d e.
  c IN ring_carrier r ==>
  coeff e (const_x_pow r c d)
  = if e = d then c else ring_0 r
`,
  intro THEN
  simp[const_x_pow_expand;coeff] THEN
  qed[map0to_injective]
);;

let coeff_x_pow = prove(`
  !(r:A ring) d e.
  coeff e (x_pow r d)
  = if e = d then ring_1 r else ring_0 r
`,
  qed[coeff_const_x_pow;const_x_pow_1;RING_1]
);;

let coeff_poly_const = prove(`
  !(r:A ring) c e.
  c IN ring_carrier r ==>
  coeff e (poly_const r c)
  = if e = 0 then c else ring_0 r
`,
  qed[const_x_pow_deg0;coeff_const_x_pow]
);;

let coeff_x = prove(`
  !(r:A ring) e.
  coeff e (poly_x r)
  = if e = 1 then ring_1 r else ring_0 r
`,
  rw[poly_x] THEN
  qed[coeff_x_pow]
);;

let x_pow_is_pow_of_x = prove(`
  !(r:A ring) n.
  x_pow r n = ring_pow(x_ring r) (poly_x r) n
`,
  GEN_TAC THEN
  INDUCT_TAC THENL [
    rw[x_pow_0;RING_POW_0;x_ring_1]
  ;
    rw[ring_pow;ADD1] THEN
    once_rw[ADD_SYM] THEN
    rw[GSYM x_pow_mul] THEN
    simp[x_ring_mul;poly_x]
  ]
);;

let poly_const_pow = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  ring_pow(x_ring r) (poly_const r c) d
  = poly_const r (ring_pow r c d)
`,
  GEN_TAC THEN
  GEN_TAC THEN
  INDUCT_TAC THENL [
    rw[RING_POW_0;x_ring_1;poly_1];
    rw[ring_pow;x_ring_mul] THEN
    simp[RING_POW;POLY_CONST_MUL]
  ]
);;

let coeff_poly_const_times = prove(`
  !(r:A ring) c p d.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  coeff d (ring_mul(x_ring r) (poly_const r c) p)
  = ring_mul r c (coeff d p)
`,
  intro THEN
  have `ring_powerseries(r:A ring) (p:(num->num)->A)` [in_x_ring_carrier_implies_powerseries] THEN
  rw[x_ring_mul] THEN
  simp[poly_const_mul_expand] THEN
  rw[coeff]
);;

let coeff_sum = prove(`
  !(r:R ring) d (f:X->(num->num)->R) S.
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  coeff d (ring_sum(x_ring r) S f)
  = ring_sum r S (\s. coeff d (f s))
`,
  intro THEN
  have_eqlambda `(coeff d) o (f:X->(num->num)->R) = (\s. coeff d (f s))` [o_DEF] THEN
  qed[coeff_sum_o]
);;

let coeff_sum_const_x_pow = prove(`
  !(r:R ring) d c t.
  (!d. d < t ==> c d IN ring_carrier r) ==>
  coeff d (ring_sum(x_ring(r:R ring)) {d:num | d < t} (\d. const_x_pow r (c d) d))
  = if d < t then c d else ring_0 r
`,
  intro THEN
  have `!d:num. d < t ==> const_x_pow r (c d) d IN ring_carrier(x_ring(r:R ring))` [const_x_pow_in_x_ring] THEN
  set_tac `!d:num. d IN {d:num | d < t} <=> d < t` [] THEN
  have `!d:num. d IN {d:num | d < t} ==> const_x_pow r (c d) d IN ring_carrier(x_ring(r:R ring))` [] THEN
  have `!d:num. d IN {d:num | d < t} ==> c d IN ring_carrier(r:R ring)` [] THEN
  have `FINITE {d:num | d < t}` [FINITE_NUMSEG_LT] THEN
  simp[coeff_sum;coeff_const_x_pow;ring_sum_delta_flip_fun] THEN
  qed[]
);;

(* ----- support *)

let x_support = new_definition `
  x_support (r:R ring) (p:(num->num)->R)
  = {d | ~(coeff d p = ring_0 r)}
`;;

let in_x_support = prove(`
  !(r:R ring) d p.
  d IN x_support r p
  <=> ~(coeff d p = ring_0 r)
`,
  SET_TAC[x_support]
);;

let x_support_apply = prove(`
  !(r:A ring) d p.
  (x_support r p) d
  <=> ~(coeff d p = ring_0 r)
`,
  rw[x_support;IN_ELIM_THM]
);;

let support_const_x_pow = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  x_support r (const_x_pow r c d)
  = if c = ring_0 r then {} else {d}
`,
  intro THEN
  simp[x_support;coeff_const_x_pow] THEN
  splitcases `c = ring_0 (r:A ring)` [
    simp[COND_ID] THEN
    SET_TAC[]
  ;
    simp[] THEN
    rw[FUN_EQ_THM;IN_ELIM_THM;sing_eq] THEN
    qed[]
  ]
);;

let max_support_const_x_pow = prove(`
  !(r:A ring) c n.
  c IN ring_carrier r ==>
  ~(c = ring_0 r) ==>
  maximum (x_support r (const_x_pow r c n)) = n
`,
  intro THEN
  simp[support_const_x_pow] THEN
  qed[maximum_sing]
);;

let support_x_pow = prove(`
  !(r:A ring) d.
  x_support r (x_pow r d)
  = if ring_1 r = ring_0 r then {} else {d}
`,
  intro_genonly THEN
  rw[GSYM const_x_pow_1] THEN
  qed[RING_1;support_const_x_pow]
);;

let max_support_x_pow = prove(`
  !(r:A ring) n.
  ~(ring_1 r = ring_0 r) ==>
  maximum (x_support r (x_pow r n)) = n
`,
  intro THEN
  rw[GSYM const_x_pow_1] THEN
  qed[RING_1;max_support_const_x_pow]
);;

let monomials_are_map0to = prove(`
  !r:A ring.
  !p:(num->num)->A.
  p IN ring_carrier(x_ring r) ==>
  {m | ~(p m = ring_0 r)}
  = IMAGE map0to (x_support r p)
`,
  rw[x_support] THEN
  rw[GSYM SIMPLE_IMAGE_GEN;EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  forwardreverse [
    STRIP_TAC THEN
    have `monomial_vars (x:num->num) SUBSET {0}` [in_x_ring_carrier_implies_monomial_var_subset_0] THEN
    have `{i:num | ~(x i = 0)} SUBSET {0}` [monomial_vars] THEN
    have `x = map0to (x 0)` [supported_on_0_implies_map0to] THEN
    EXISTS_TAC `x 0:num` THEN
    rw[coeff] THEN
    qed[]
  ;
    STRIP_TAC THEN
    qed[coeff]
  ]
);;

let finite_x_support_lemma = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  FINITE {m | ~(p m = ring_0 r)}
`,
  rw[x_ring;POLY_RING;ring_polynomial;IN;IN_ELIM_THM] THEN
  qed[]
);;

let finite_x_support = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  FINITE (x_support r p)
`,
  intro THEN
  have `FINITE {m | ~((p:(num->num)->A) m = ring_0 (r:A ring))}` [finite_x_support_lemma] THEN
  qed[monomials_are_map0to;finite_image_map0to_eq]
);;

let empty_x_support = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  x_support r p = {} ==>
  p = poly_0 r
`,
  intro THEN
  rw[poly_0;poly_const;COND_ID] THEN
  have `{m | ~(p m = ring_0 (r:A ring))} = IMAGE map0to {}` [monomials_are_map0to] THEN
  have `{m:num->num | ~(p m = ring_0 (r:A ring))} = {}` [image_empty] THEN
  rw[FUN_EQ_THM] THEN
  GEN_TAC THEN
  have `x IN {m:num->num | ~(p m = ring_0 (r:A ring))} <=> x IN {}` [] THEN
  have `~(x IN {m:num->num | ~(p m = ring_0 (r:A ring))})` [in_empty] THEN
  have `~({m:num->num | ~(p m = ring_0 (r:A ring))} x)` [IN] THEN
  specialize[`\m:num->num. ~(p m = ring_0 (r:A ring))`;`x:num->num`]setof_property_apply THEN
  qed[]
);;

(* ----- expand poly as sum of const_x_pow *)

let x_ring_expand_lemma1 = prove(`
  !r:A ring. !d.
  ring_product(x_ring r)
    (monomial_vars (map0to d))
    (\i. ring_pow(x_ring r) (poly_var r i) ((map0to d) i))
  = x_pow r d
`,
  intro_genonly THEN
  rw[map0to_monomial_vars] THEN
  splitcases `d = 0` [
    simp[] THEN
    rw[RING_PRODUCT_CLAUSES;x_ring_1;x_pow_0]
  ;
    simp[] THEN
    rw[RING_PRODUCT_SING;poly_var_0_pow_map0to_0_is_x_pow;x_pow_in_x_ring]
  ]
);;

let x_ring_expand_lemma2 = prove(`
  !r:A ring.
  !p:(num->num)->A.
  p IN ring_carrier(x_ring r) ==>
  !d.
  const_x_pow r (coeff d p) d
  = ring_mul(x_ring r)
     (poly_const r (p (map0to d)))
     (ring_product(x_ring r)
       (monomial_vars (map0to d))
       (\i. ring_pow(x_ring r) (poly_var r i) ((map0to d) i)))
`,
  intro THEN
  rw[const_x_pow] THEN
  rw[x_ring_expand_lemma1] THEN
  rw[x_ring;POLY_RING] THEN
  rw[coeff;map0to]
);;

let x_ring_expand_lemma3 = prove(`
  !r:A ring.
  !p:(num->num)->A.
  p IN ring_carrier(x_ring r) ==>
  (\d. const_x_pow r (coeff d p) d)
  = (\m. ring_mul(x_ring r)
         (poly_const r (p m))
         (ring_product(x_ring r)
           (monomial_vars m)
           (\i. ring_pow(x_ring r) (poly_var r i) (m i))))
    o map0to
`,
  intro THEN
  sufficesby EQ_EXT THEN
  simp[o_THM] THEN
  qed[x_ring_expand_lemma2]
);;

let x_ring_expand_lemma4 = prove(`
  !r:A ring.
  !p:(num->num)->A.
  p IN ring_carrier(x_ring r) ==>
  ring_sum (poly_ring r {0})
    {m | ~(p m = ring_0 r)}
    (\m. ring_mul (poly_ring r {0}) (poly_const r (p m))
           (ring_product (poly_ring r {0}) (monomial_vars m)
           (\i. ring_pow (poly_ring r {0}) (poly_var r i) (m i)))) =
  ring_sum (x_ring r)
    (x_support r p)
    (\d. const_x_pow r (coeff d p) d)
`,
  intro THEN
  simp[monomials_are_map0to] THEN
  rw[ring_sum_image_map0to] THEN
  simp[x_ring_expand_lemma3] THEN
  rw[x_ring]
);;

let x_ring_expand = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  ring_sum
    (x_ring r)
    (x_support r p)
    (\d. const_x_pow r (coeff d p) d)
  = p
`,
  intro THEN
  have `p IN ring_carrier(poly_ring (r:A ring) {0})` [x_ring] THEN
  specialize[`r:A ring`;`{0}`;`p:(num->num)->A`]POLY_RING_EXPAND THEN
  specialize[`r:A ring`;`p:(num->num)->A`]x_ring_expand_lemma4 THEN
  qed[]
);;

let coeff_x_pow_times = prove(`
  !(r:A ring) p n d.
  p IN ring_carrier(x_ring r) ==>
  coeff (n+d) (ring_mul(x_ring r) (x_pow r n) p)
  = coeff d p
`,
  intro THEN
  have `p = ring_sum (x_ring(r:A ring)) (x_support r p) (\d:num. const_x_pow r (coeff d p) d)` [x_ring_expand] THEN
  have `ring_mul(x_ring r) (x_pow r n) p = ring_mul(x_ring r) (x_pow r n) (ring_sum (x_ring(r:A ring)) (x_support r p) (\d:num. const_x_pow r (coeff d p) d))` [] THEN
  have `FINITE (x_support (r:A ring) p)` [finite_x_support] THEN
  have `x_pow (r:A ring) n IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  have `!d:num. coeff d p IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `!d:num. const_x_pow r (coeff d p) d IN ring_carrier(x_ring(r:A ring))` [const_x_pow_in_x_ring] THEN
  specialize_raw[`x_ring(r:A ring)`;`\d:num. const_x_pow r (coeff d p:A) d`;`x_pow(r:A ring) n`;`x_support(r:A ring) p`]RING_SUM_LMUL THEN
  have `ring_sum(x_ring(r:A ring)) (x_support r p) (\d:num. ring_mul(x_ring r) (x_pow r n) (const_x_pow r (coeff d p) d)) = ring_mul(x_ring r) (x_pow r n) (ring_sum(x_ring r) (x_support r p) (\d:num. const_x_pow r (coeff d p) d))` [] THEN
  have `ring_mul(x_ring r) (x_pow r n) p = ring_sum(x_ring(r:A ring)) (x_support r p) (\d:num. ring_mul(x_ring r) (x_pow r n) (const_x_pow r (coeff d p) d))` [] THEN
  have `!d:num. ring_mul (x_ring(r:A ring)) (x_pow r n) (const_x_pow r (coeff d p) d) = const_x_pow r (coeff d p) (n+d)` [x_pow_mul_const_x_pow;x_ring_mul] THEN
  have `ring_sum(x_ring(r:A ring)) (x_support r p) (\d:num. ring_mul(x_ring r) (x_pow r n) (const_x_pow r (coeff d p) d)) = ring_sum(x_ring(r:A ring)) (x_support r p) (\d:num. const_x_pow r (coeff d p) (n+d))` [RING_SUM_EQ] THEN
  have `ring_mul(x_ring r) (x_pow r n) p = ring_sum(x_ring(r:A ring)) (x_support r p) (\d:num. const_x_pow r (coeff d p) (n+d))` [RING_SUM_EQ] THEN
  have `!d:num. const_x_pow r (coeff d p) (n+d) IN ring_carrier(x_ring(r:A ring))` [const_x_pow_in_x_ring] THEN
  specialize_raw[`r:A ring`;`n+d:num`;`\d:num. const_x_pow(r:A ring) (coeff d p) (n+d)`;`x_support(r:A ring) p`]coeff_sum THEN
  have `coeff (n+d) (ring_sum(x_ring r) (x_support r p) (\i:num. const_x_pow r (coeff i p) (n+i))) = ring_sum(r:A ring) (x_support r p) (\i:num. coeff (n+d) (const_x_pow r (coeff i p) (n+i)))` [] THEN
  have `coeff (n+d) (ring_mul (x_ring r) (x_pow r n) p) = ring_sum(r:A ring) (x_support r p) (\i:num. coeff (n+d) (const_x_pow r (coeff i p) (n+i)))` [] THEN
  have `!i:num. coeff (n + d) (const_x_pow(r:A ring) (coeff i p) (n + i)) = (if d = i then coeff i p else ring_0 r)` [coeff_const_x_pow;ARITH_RULE `n+d = n+i <=> d = i:num`] THEN
  specialize_raw[`r:A ring`;`\i:num. coeff (n+d) (const_x_pow(r:A ring) (coeff i p) (n+i))`;`\i:num. if d = i then coeff i p else ring_0 (r:A ring)`;`x_support (r:A ring) p`]RING_SUM_EQ THEN
  have `ring_sum(r:A ring) (x_support r p) (\i:num. coeff (n+d) (const_x_pow r (coeff i p) (n+i))) = ring_sum(r:A ring) (x_support r p) (\i:num. if d = i then coeff i p else ring_0 r)` [] THEN
  have `coeff (n+d) (ring_mul (x_ring r) (x_pow r n) p) = ring_sum(r:A ring) (x_support r p) (\i:num. if d = i then coeff i p else ring_0 r)` [] THEN
  simp[ring_sum_delta_flip_fun] THEN
  qed[in_x_support]
);;

let coeff_x_pow_times_lt = prove(`
  !(r:R ring) p n d.
  p IN ring_carrier(x_ring r) ==>
  d < n ==>
  coeff d (ring_mul(x_ring r) (x_pow r n) p)
  = ring_0 r
`,
  rw[x_ring_mul;coeff_mul_poly_oneindex] THEN
  intro THEN
  subgoal `!a:num. a IN {a | a <= d} ==> ring_mul(r:R ring) (coeff a (x_pow r n)) (coeff (d-a) p) = ring_0 r` THENL [
    intro THEN
    set_tac `a:num IN {a | a <= d} ==> a <= d` [] THEN
    have `a:num <= d` [] THEN
    num_linear `a:num <= d ==> d < n ==> ~(a = n)` THEN
    simp[coeff_x_pow] THEN
    qed[ring_0_mul;coeff_in_ring]
  ; 
    qed[RING_SUM_EQ_0]
  ]
);;

let coeff_const_x_pow_times = prove(`
  !(r:A ring) p c n d.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  coeff (n+d) (ring_mul(x_ring r) (const_x_pow r c n) p)
  = ring_mul r c (coeff d p)
`,
  intro THEN
  rw[const_x_pow] THEN
  rw[GSYM x_ring_mul] THEN
  have `poly_const(r:A ring) c IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `x_pow(r:A ring) n IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  have `ring_mul(x_ring(r:A ring)) (ring_mul(x_ring r) (poly_const r c) (x_pow r n)) p = ring_mul(x_ring r) (x_pow r n) (ring_mul(x_ring r) (poly_const r c) p)` [RING_RULE `ring_mul(r:R ring) (ring_mul r a b) c = ring_mul r b (ring_mul r a c)`] THEN
  have `ring_mul(x_ring(r:A ring)) (poly_const r c) p IN ring_carrier(x_ring r)` [RING_MUL] THEN
  simp[coeff_x_pow_times] THEN
  simp[coeff_poly_const_times]
);;

let eq_if_coeff_eq = prove(`
  !(r:R ring) p q.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  (!d. coeff d p = coeff d q) ==>
  p = q
`,
  intro THEN
  have `!d. ~(coeff d p = ring_0(r:R ring)) <=> ~(coeff d q = ring_0(r:R ring))` [] THEN
  set_tac `(!d. ~(coeff d p = ring_0(r:R ring)) <=> ~(coeff d q = ring_0(r:R ring))) ==> {d | ~(coeff d p = ring_0 r)} = {d | ~(coeff d q = ring_0 r)}` [] THEN
  have `x_support(r:R ring) p = x_support r q` [x_support] THEN
  have `ring_sum (x_ring(r:R ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d) = ring_sum (x_ring(r:R ring)) (x_support r p) (\d. const_x_pow r (coeff d q) d)` [RING_SUM_EQ] THEN
  qed[x_ring_expand]
);;

(* ----- powers of 2 *)

let twopow_nonzero = prove(`
  !n. ~(2 EXP n = 0)
`,
  qed[EXP_EQ_0;ARITH_RULE `~(2 = 0)`]
);;

let twopow_positive = prove(`
  !n. 0 < 2 EXP n
`,
  qed[EXP_LT_0;ARITH_RULE `~(2 = 0)`]
);;

let twopow_injective = prove(`
  !m n.
  2 EXP m = 2 EXP n ==> m = n
`,
  rw[EQ_EXP] THEN
  ARITH_TAC
);;

let twopow_mono_le = prove(`
  !m n.
  2 EXP m <= 2 EXP n <=> m <= n
`,
  rw[LE_EXP] THEN
  ARITH_TAC
);;

let twopow_mono_lt = prove(`
  !m n.
  2 EXP m < 2 EXP n <=> m < n
`,
  rw[LT_EXP] THEN
  ARITH_TAC
);;

let twopow_ge1 = prove(`
  !n. 1 <= 2 EXP n
`,
  qed[twopow_mono_le;ARITH_RULE `2 EXP 0 = 1`;ARITH_RULE `0 <= n`]
);;

let twopow_minus_1_lt = prove(`
  !n.
  2 EXP n - 1 < 2 EXP n
`,
  intro THEN
  num_linear `0 <= n` THEN
  num_linear `1 = 2 EXP 0` THEN
  have `2 EXP 0 <= 2 EXP n` [twopow_mono_le] THEN
  have `1 <= 2 EXP n` [] THEN
  have `2 EXP n = (2 EXP n - 1) + 1` [SUB_ADD] THEN
  have `2 EXP n = SUC(2 EXP n - 1)` [ADD1] THEN
  qed[LT]
);;

let lt_twopow_iff_le = prove(`
  !m n.
  m < 2 EXP n <=> m <= 2 EXP n - 1
`,
  intro THEN
  forwardreverse [
    qed[le_minus_1_if_lt]
  ;
    qed[twopow_minus_1_lt;LET_TRANS]
  ]
);;

let twopow_lt_minus1 = prove(`
  !m n.
  m < n ==> 2 EXP m <= 2 EXP n - 1
`,
  intro THEN
  have `2 EXP m < 2 EXP n` [twopow_mono_lt] THEN
  qed[le_minus_1_if_lt]
);;

(* also in library as LT_POW2_REFL *)
let twopow_above = prove(`
  !n.
  n < 2 EXP n
`,
  INDUCT_TAC THENL [
    ARITH_TAC;
    rw[ADD1;EXP_ADD;EXP_1] THEN
    num_linear `n < 2 EXP n ==> n+1 < (2 EXP n)*2` THEN
    qed[]
  ]
);;

let twopow_subset = prove(`
  !n.
  {d | 2 EXP d <= n} SUBSET {d | d < n}
`,
  rw[SUBSET;IN_ELIM_THM] THEN
  qed[twopow_above;LTE_TRANS]
);;

let twopow_finite = prove(`
  !n.
  FINITE {d | 2 EXP d <= n}
`,
  GEN_TAC THEN
  have `FINITE {d:num | d < n}` [FINITE_NUMSEG_LT] THEN
  have `{d | 2 EXP d <= n} SUBSET {d | d < n}` [twopow_subset] THEN
  qed[FINITE_SUBSET]
);;

let twopow_0 = prove(`
  {d | 2 EXP d <= 0} = {}
`,
  sufficesby EQ_EXT THEN
  rw[EMPTY;IN_ELIM_THM;LE;EXP_EQ_0] THEN
  ARITH_TAC
);;

let twopow_subset_maximum = prove(`
  !H S.
  ~(S = {}) ==>
  S SUBSET {d | 2 EXP d <= H} ==>
  2 EXP (maximum S) <= H
`,
  intro THEN
  have `FINITE {d | 2 EXP d <= H}` [twopow_finite] THEN
  have `FINITE (S:num->bool)` [FINITE_SUBSET] THEN
  have `S (maximum S)` [maximum_finite_nonempty] THEN
  have `maximum S IN S` [IN] THEN
  have `maximum S IN {d | 2 EXP d <= H}` [SUBSET] THEN
  have `{d | 2 EXP d <= H} (maximum S)` [IN] THEN
  specialize[`\d. 2 EXP d <= H`;`maximum S`]setof_property_apply THEN
  qed[]
);;

let twopow_le_0_lt_d = prove(`
  !m n.
  m <= 2 EXP 0 ==>
  n < 2 EXP d ==>
  m*n < 2 EXP d
`,
  intro THEN
  num_linear `m <= 2 EXP 0 ==> m = 0 \/ m = 1` THEN
  num_linear `0*n = 0` THEN
  num_linear `1*n = n` THEN
  qed[twopow_positive]
);;

let twopow_mul_twopow_minus_1 = prove(`
  !m n.
  (2 EXP m) * ((2 EXP n) - 1) < 2 EXP (m+n)
`,
  intro THEN
  have `2 EXP n - 1 < 2 EXP n` [twopow_minus_1_lt] THEN
  have `~(2 EXP m = 0)` [twopow_nonzero] THEN
  have `2 EXP m * 2 EXP n = 2 EXP (m+n)` [EXP_ADD] THEN
  have `2 EXP m * (2 EXP n - 1) < 2 EXP m * 2 EXP n` [LT_LMULT] THEN
  qed[]
);;

(* ----- twodeg *)

let twodeg = new_definition `
  twodeg (r:R ring) (p:(num->num)->R) =
  if p = poly_0 r
  then 0
  else 2 EXP (maximum (x_support r p))
`;;

let support_le_twodeg = prove(`
  !(r:A ring) p d.
  p IN ring_carrier(x_ring r) ==>
  ~(coeff d p = ring_0 r) ==>
  2 EXP d <= twodeg r p
`,
  intro THEN
  have `~((p:(num->num)->A) = poly_0 (r:A ring))` [coeff_0] THEN
  simp[twodeg] THEN
  rw[LE_EXP] THEN
  num_linear `~(2 = 0)` THEN
  num_linear `~(2 = 1)` THEN
  simp[] THEN
  have `FINITE (x_support (r:A ring) p)` [finite_x_support] THEN
  havetac `(x_support (r:A ring) p) d` (rw[x_support;setof_property_apply] THEN qed[]) THEN
  qed[element_le_maximum_finite]
);;

let support_le_twodeg_le = prove(`
  !(r:R ring) p d H.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  ~(coeff d p = ring_0 r) ==>
  2 EXP d <= H
`,
  qed[support_le_twodeg;LE_TRANS]
);;

let support_le_twodeg_lt = prove(`
  !(r:R ring) p d H.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p < H ==>
  ~(coeff d p = ring_0 r) ==>
  2 EXP d < H
`,
  qed[support_le_twodeg;LET_TRANS]
);;

let twodeg_le_half_if_lt = prove(`
  !(r:R ring) p n.
  twodeg r p < 2 EXP n ==> 
  twodeg r p <= 2 EXP (n-1)
`,
  intro THEN
  ASM_CASES_TAC `p:(num->num)->R = poly_0 r` THENL [
    qed[twodeg;ARITH_RULE `0 <= H`]
  ;
    have `twodeg(r:R ring) p = 2 EXP maximum(x_support r p)` [twodeg] THEN
    have `maximum(x_support(r:R ring) p) < n` [twopow_mono_lt] THEN
    have `maximum(x_support(r:R ring) p) <= n-1` [ARITH_RULE `x < n ==> x <= n-1`] THEN
    qed[twopow_mono_le]
  ]
);;

let support_subset_twodeg_le = prove(`
  !(r:R ring) p H.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  x_support r p SUBSET {d | 2 EXP d <= H}
`,
  rw[x_support] THEN
  SET_TAC[support_le_twodeg_le]
);;

let support_subset_twodeg_lt = prove(`
  !(r:R ring) p H.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p < H ==>
  x_support r p SUBSET {d | 2 EXP d < H}
`,
  rw[x_support] THEN
  SET_TAC[support_le_twodeg_lt]
);;

let x_ring_expand_twodeg_lemma = prove(`
  !(r:A ring) p S.
  ring_sum (x_ring (r:A ring))
    (S DIFF (x_support r p))
    (\d. const_x_pow r (coeff d p) d)
  = ring_0 (x_ring (r:A ring))
`,
  intro_genonly THEN
  sufficesby RING_SUM_EQ_0 THEN
  rw[DIFF;x_support;IN_ELIM_THM] THEN
  intro THEN
  simp[] THEN
  rw[const_x_pow] THEN
  have `x_pow (r:A ring) a IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  have `ring_mul (x_ring (r:A ring)) (ring_0 (x_ring r)) (x_pow r a) = ring_0 (x_ring r)` [ring_0_mul] THEN
  have `poly_mul r = ring_mul (x_ring (r:A ring))` [x_ring_mul] THEN
  have `poly_0 r = ring_0 (x_ring (r:A ring))` [x_ring_0] THEN
  have `poly_const (r:A ring) (ring_0 r) = (poly_0 r):(num->num)->A` [poly_0] THEN
  qed[]
);;
 
let x_ring_expand_twodeg = prove(`
  !(r:A ring) p H.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  ring_sum (x_ring r)
    {d | 2 EXP d <= H}
    (\d. const_x_pow r (coeff d p) d)
  = p
`,
  intro THEN
  specialize[`H:num`]twopow_finite THEN
  have `x_support (r:A ring) p SUBSET {d | 2 EXP d <= H}` [support_subset_twodeg_le] THEN
  have `
    ring_sum (x_ring (r:A ring)) {d | 2 EXP d <= H} (\d. const_x_pow r (coeff d p) d)
    = ring_add (x_ring (r:A ring))
        (ring_sum (x_ring (r:A ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d))
        (ring_sum (x_ring (r:A ring)) ({d | 2 EXP d <= H} DIFF (x_support r p)) (\d. const_x_pow r (coeff d p) d))
  ` [ring_sum_diff2] THEN
  have `
    ring_sum (x_ring (r:A ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d)
      = p
  ` [x_ring_expand] THEN
  have `
    ring_sum (x_ring (r:A ring)) ({d | 2 EXP d <= H} DIFF (x_support r p)) (\d. const_x_pow r (coeff d p) d) 
      = ring_0 (x_ring (r:A ring))
  ` [x_ring_expand_twodeg_lemma] THEN
  have `ring_add (x_ring (r:A ring)) (p:(num->num)->A) (ring_0 (x_ring (r:A ring))) = p` [ring_add_zero] THEN
  qed[]
);;

let twodeg_0 = prove(`
  !(r:A ring).
  twodeg r (poly_0 r) = 0
`,
  rw[twodeg]
);;

let twodeg_only_0 = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p = 0 ==>
  p = poly_0 r
`,
  intro THEN
  have `twodeg (r:A ring) p <= 0` [ARITH_RULE `0 <= 0`] THEN
  specialize[`r:A ring`;`p:(num->num)->A`;`0`]x_ring_expand_twodeg THEN
  have `{d | 2 EXP d <= 0} = {}` [twopow_0] THEN
  have `p = ring_sum (x_ring (r:A ring)) {} (\d. const_x_pow r (coeff d p) d)` [] THEN
  qed[RING_SUM_CLAUSES;x_ring_0]
);;

let lead_nonzero = prove(`
  !(r:A ring) p d.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p = 2 EXP d ==>
  ~(coeff d p = ring_0 r)
`,
  intro THEN
  have `~(twodeg (r:A ring) p = 0)` [twopow_nonzero] THEN
  have `~(p:(num->num)->A = poly_0 r)` [twodeg_0] THEN
  have `d = maximum (x_support (r:A ring) p)` [twodeg;twopow_injective] THEN
  have `FINITE(x_support(r:A ring) p)` [finite_x_support] THEN
  have `~(x_support (r:A ring) p = {})` [empty_x_support] THEN
  have `(x_support(r:A ring) p) d` [maximum_finite_nonempty] THEN
  have `~(coeff d p = ring_0(r:A ring))` [x_support;IN_ELIM_THM] THEN
  qed[]
);;

let twodeg_qedring = prove(`
  !(r:A ring) p.
  ring_1 r = ring_0 r ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r p = 0
`,
  intro THEN
  have `trivial_ring (r:A ring)` [TRIVIAL_RING_10] THEN
  have `trivial_ring (poly_ring (r:A ring) {0})` [TRIVIAL_POLY_RING] THEN
  have `trivial_ring (x_ring (r:A ring))` [x_ring] THEN
  have `(p:(num->num)->A) IN {ring_0 (x_ring (r:A ring))}` [trivial_ring] THEN
  have `(p:(num->num)->A) = ring_0 (x_ring (r:A ring))` [IN_SING] THEN
  have `(p:(num->num)->A) = poly_0 (r:A ring)` [x_ring_0] THEN
  qed[twodeg_0]
);;
  
let twodeg_const_x_pow = prove(`
  !(r:A ring) n c.
  c IN ring_carrier r ==>
  twodeg r (const_x_pow r c n)
  = if c = ring_0 r then 0 else 2 EXP n
`,
  intro THEN
  splitcases `c = ring_0 (r:A ring)` [
    qed[const_x_pow_0;twodeg_0]
  ;
    rw[twodeg] THEN
    have `~(const_x_pow r c n = poly_0 (r:A ring))` [const_x_pow_nonzero] THEN
    simp[max_support_const_x_pow]
  ]
);;

let twodeg_poly_const = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  twodeg r (poly_const r c)
  = if c = ring_0 r then 0 else 2 EXP 0
`,
  intro THEN
  simp[GSYM const_x_pow_deg0;twodeg_const_x_pow]
);;

let twodeg_poly_const_le = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  twodeg r (poly_const r c) <= 2 EXP 0
`,
  intro THEN
  simp[twodeg_poly_const] THEN
  qed[LE_REFL;ARITH_RULE `0 <= 2 EXP 0`]
);;

let twodeg_x_pow = prove(`
  !(r:A ring) n.
  twodeg r (x_pow r n)
  = if ring_1 r = ring_0 r then 0 else 2 EXP n
`,
  qed[twodeg_const_x_pow;RING_1;const_x_pow_1]
);;

let twodeg_x = prove(`
  !(r:A ring).
  twodeg r (poly_x r)
  = if ring_1 r = ring_0 r then 0 else 2 EXP 1
`,
  rw[poly_x] THEN
  qed[twodeg_x_pow]
);;

let twodeg_poly_1 = prove(`
  !(r:A ring).
  twodeg r (poly_1 r)
  = if ring_1 r = ring_0 r then 0 else 2 EXP 0
`,
  intro THEN
  have `ring_1 (r:A ring) IN ring_carrier r` [RING_1] THEN
  simp[poly_1;twodeg_poly_const]
);;

let twodeg_le_if_lemma1 = prove(`
  !(r:A ring) p H.
  (!d. ~(coeff d p = ring_0 r) ==> 2 EXP d <= H) ==>
  x_support r p SUBSET {d | 2 EXP d <= H}
`,
  rw[x_support;SUBSET;IN_ELIM_THM]
);;

let twodeg_le_if = prove(`
  !(r:A ring) p H.
  p IN ring_carrier(x_ring r) ==>
  (!d. ~(coeff d p = ring_0 r) ==> 2 EXP d <= H) ==>
  twodeg r p <= H
`,
  intro THEN
  splitcases `(p:(num->num)->A) = poly_0 r` [
    simp[twodeg_0;LE_0]
  ;
    simp[twodeg] THEN
    have `x_support (r:A ring) p SUBSET {d | 2 EXP d <= H}` [twodeg_le_if_lemma1] THEN
    have `~(x_support (r:A ring) p = {})` [empty_x_support] THEN
    qed[twopow_subset_maximum]
  ]
);;

let twodeg_lt_support = prove(`
  !(r:R ring) p n.
  p IN ring_carrier(x_ring r) ==>
  (!d. n <= d ==> coeff d p = ring_0 r) ==>
  twodeg r p < 2 EXP n
`,
  intro THEN
  havetac `!d. ~(coeff d p = ring_0(r:R ring)) ==> 2 EXP d <= 2 EXP n - 1` (
    intro THEN
    have `~(n <= d:num)` [] THEN
    num_linear `~(n <= d:num) ==> d < n` THEN
    have `2 EXP d < 2 EXP n` [twopow_mono_lt] THEN
    qed[lt_twopow_iff_le]
  ) THEN
  have `twodeg(r:R ring) p <= 2 EXP n - 1` [twodeg_le_if] THEN
  qed[lt_twopow_iff_le]
);;

let shift_twodeg_lt_support = prove(`
  !(r:R ring) p t n.
  p IN ring_carrier(x_ring r) ==>
  (!d. n <= d + t ==> coeff d p = ring_0 r) ==>
  2 EXP t * twodeg r p < 2 EXP n
`,
  intro THEN
  handlecase `n:num <= t` (
    have `!d. 0 <= d ==> coeff d p = ring_0(r:R ring)` [ARITH_RULE `n <= t ==> 0 <= d ==> n <= d+t`] THEN
    have `twodeg(r:R ring) p < 2 EXP 0` [twodeg_lt_support] THEN
    have `twodeg(r:R ring) p = 0` [ARITH_RULE `x < 2 EXP 0 ==> x = 0`] THEN
    have `2 EXP t * twodeg(r:R ring) p = 0` [MULT_CLAUSES] THEN
    qed[twopow_positive]
  )
  THEN
  have `!d. n-t <= d ==> coeff d p = ring_0(r:R ring)` [ARITH_RULE `~(n <= t) ==> n - t <= d:num ==> n <= d + t`] THEN
  have `twodeg(r:R ring) p < 2 EXP (n-t)` [twodeg_lt_support] THEN
  have `2 EXP t * twodeg(r:R ring) p < 2 EXP t * 2 EXP(n-t)` [LT_LMULT;twopow_nonzero] THEN
  num_linear `~(n <= t:num) ==> n = t + (n-t)` THEN
  have `2 EXP n = 2 EXP t * 2 EXP(n-t)` [EXP_ADD] THEN
  qed[]
);;

let twodeg_sub_lt_if_lead_cancel_lemma = prove(`
  !(r:R ring) p q n d.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p = 2 EXP n ==>
  twodeg r q = 2 EXP n ==>
  coeff n p = coeff n q ==>
  n <= d ==>
  coeff d p = coeff d q
`,
  intro THEN
  handlecase `n = d:num` (
    qed[]
  ) THEN
  num_linear `n <= d:num ==> ~(n = d) ==> n < d` THEN
  have `2 EXP n < 2 EXP d` [twopow_mono_lt] THEN
  have `~(2 EXP d <= 2 EXP n)` [NOT_LT] THEN
  have `~(2 EXP d <= twodeg(r:R ring) p)` [] THEN
  have `~(2 EXP d <= twodeg(r:R ring) q)` [] THEN
  have `coeff d p = ring_0 r:R` [support_le_twodeg;NOT_LT] THEN
  have `coeff d q = ring_0 r:R` [support_le_twodeg;NOT_LT] THEN
  qed[]
);;

let twodeg_sub_lt_if_lead_cancel = prove(`
  !(r:R ring) p q n.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p = 2 EXP n ==>
  twodeg r q = 2 EXP n ==>
  coeff n p = coeff n q ==>
  twodeg r (ring_sub(x_ring r) p q) < 2 EXP n
`,
  intro THEN
  have `ring_sub(x_ring r) p q IN ring_carrier(x_ring(r:R ring))` [RING_SUB] THEN
  have `!d. n <= d ==> coeff d p = coeff d q:R` [twodeg_sub_lt_if_lead_cancel_lemma] THEN
  have `!d. n <= d ==> coeff d (ring_sub(x_ring r) p q) = ring_0(r:R ring)` [coeff_sub;coeff_in_ring;RING_SUB_REFL] THEN
  qed[twodeg_lt_support]
);;

let twodeg_add_le_lemma = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  twodeg r q <= H ==>
  !d. ~(coeff d (ring_add(x_ring r) p q) = ring_0 r) ==> 2 EXP d <= H
`,
  intro_genonly THEN
  have `ring_add (x_ring (r:A ring)) = poly_add r` [x_ring_add] THEN
  simp[poly_add;coeff] THEN
  intro THEN
  splitcases `coeff d p = ring_0 (r:A ring)` [
    splitcases `coeff d q = ring_0 (r:A ring)` [
      have `p (map0to d) = ring_0 (r:A ring)` [coeff] THEN
      have `q (map0to d) = ring_0 (r:A ring)` [coeff] THEN
      have `ring_add (r:A ring) (p (map0to d)) (q (map0to d)) = ring_0 r` [RING_0;RING_ADD_LZERO] THEN
      qed[]
    ;
      qed[support_le_twodeg_le]
    ]
  ;
    qed[support_le_twodeg_le]
  ]
);;

let twodeg_add_le = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  twodeg r q <= H ==>
  twodeg r (ring_add(x_ring r) p q) <= H
`,
  intro THEN
  have `ring_add(x_ring (r:A ring)) p q IN ring_carrier(x_ring r)` [RING_ADD] THEN
  have `!d. ~(coeff d (ring_add(x_ring r) p q) = ring_0 (r:A ring)) ==> 2 EXP d <= H` [twodeg_add_le_lemma] THEN
  qed[twodeg_le_if]
);;

let twodeg_sum_le = prove(`
  !(r:A ring) (S:X->bool) f H.
  (!s. s IN S ==> twodeg r (f s) <= H) ==>
  twodeg r (ring_sum(x_ring r) S f) <= H
`,
  intro THEN
  have `twodeg (r:A ring) (ring_0(x_ring r)) <= H` [x_ring_0;twodeg_0;ARITH_RULE `0 <= H`] THEN
  have `!p q. p IN ring_carrier(x_ring(r:A ring)) /\ q IN ring_carrier(x_ring r) /\ twodeg r p <= H /\ twodeg r q <= H ==> twodeg r (ring_add(x_ring r) p q) <= H` [twodeg_add_le] THEN
  ASSUME_TAC(ISPECL[`x_ring(r:A ring)`;`\p. twodeg(r:A ring) p <= H`;`f:X->(num->num)->A`;`S:X->bool`]RING_SUM_CLOSED) THEN
  qed[]
);;

let twodeg_add_lt = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p < H ==>
  twodeg r q < H ==>
  twodeg r (ring_add(x_ring r) p q) < H
`,
  intro THEN
  have `twodeg (r:A ring) p <= H-1` [le_minus_1_if_lt] THEN
  have `twodeg (r:A ring) q <= H-1` [le_minus_1_if_lt] THEN
  have `twodeg (r:A ring) (ring_add(x_ring r) p q) <= H-1` [twodeg_add_le] THEN
  have `H-1 < H:num` [minus_1_lt_if_lt] THEN
  qed[LET_TRANS]
);;

let twodeg_sum_lt = prove(`
  !(r:A ring) (S:X->bool) f d.
  (!s. s IN S ==> twodeg r (f s) < 2 EXP d) ==>
  twodeg r (ring_sum(x_ring r) S f) < 2 EXP d
`,
  intro THEN
  have `twodeg (r:A ring) (ring_0(x_ring r)) < 2 EXP d` [x_ring_0;twodeg_0;twopow_positive] THEN
  have `!p q. p IN ring_carrier(x_ring(r:A ring)) /\ q IN ring_carrier(x_ring r) /\ twodeg r p < 2 EXP d /\ twodeg r q < 2 EXP d ==> twodeg r (ring_add(x_ring r) p q) < 2 EXP d` [twodeg_add_lt] THEN
  ASSUME_TAC(ISPECL[`x_ring(r:A ring)`;`\p. twodeg(r:A ring) p < 2 EXP d`;`f:X->(num->num)->A`;`S:X->bool`]RING_SUM_CLOSED) THEN
  qed[]
);;

let twodeg_sum_const_x_pow_lt = prove(`
  !(r:R ring) c t.
  (!d. d < t ==> c d IN ring_carrier r) ==>
  twodeg r (ring_sum(x_ring(r:R ring)) {d:num | d < t} (\d. const_x_pow r (c d) d))
  < 2 EXP t
`,
  intro THEN
  set_tac `!d. d IN {d:num | d < t} ==> d < t` [] THEN
  have `!d. d < t ==> twodeg (r:R ring) (const_x_pow r (c d) d) <= 2 EXP d` [twodeg_const_x_pow;ARITH_RULE `0 <= H`;LE_REFL] THEN
  have `!d. d < t ==> 2 EXP d < 2 EXP t` [twopow_mono_lt] THEN
  have `!d. d < t ==> twodeg (r:R ring) (const_x_pow r (c d) d) < 2 EXP t` [LET_TRANS] THEN
  qed[twodeg_sum_lt]
);;

let twodeg_sum_const_x_pow_le = prove(`
  !(r:R ring) c t.
  (!d. d <= t ==> c d IN ring_carrier r) ==>
  twodeg r (ring_sum(x_ring(r:R ring)) {d:num | d <= t} (\d. const_x_pow r (c d) d))
  <= 2 EXP t
`,
  intro THEN
  set_tac `!d. d IN {d:num | d <= t} ==> d <= t` [] THEN
  have `!d. d <= t ==> twodeg (r:R ring) (const_x_pow r (c d) d) <= 2 EXP d` [twodeg_const_x_pow;ARITH_RULE `0 <= H`;LE_REFL] THEN
  have `!d. d <= t ==> 2 EXP d <= 2 EXP t` [twopow_mono_le] THEN
  have `!d. d <= t ==> twodeg (r:R ring) (const_x_pow r (c d) d) <= 2 EXP t` [LE_TRANS] THEN
  qed[twodeg_sum_le]
);;

let twodeg_sum_const_x_pow_le1 = prove(`
  !(r:R ring) c t.
  (!d. d < t+1 ==> c d IN ring_carrier r) ==>
  twodeg r (ring_sum(x_ring(r:R ring)) {d:num | d < t+1} (\d. const_x_pow r (c d) d))
  <= 2 EXP t
`,
  intro THEN
  num_linear `!d:num. d <= t <=> d < t+1` THEN
  have `!d:num. d <= t ==> c d IN ring_carrier(r:R ring)` [] THEN
  havetac `{d:num | d < t+1} = {d:num | d <= t}` (rw[EXTENSION;IN_ELIM_THM] THEN qed[]) THEN
  qed[twodeg_sum_const_x_pow_le]
);;

let twodeg_sub_le_lemma = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  twodeg r q <= H ==>
  !d. ~(coeff d (ring_sub(x_ring r) p q) = ring_0 r) ==> 2 EXP d <= H
`,
  intro_genonly THEN
  have `ring_add (x_ring (r:A ring)) = poly_add r` [x_ring_add] THEN
  have `ring_neg (x_ring (r:A ring)) = poly_neg r` [x_ring_neg] THEN
  rw[ring_sub] THEN
  simp[poly_add;poly_neg;coeff] THEN
  intro THEN
  splitcases `coeff d p = ring_0 (r:A ring)` [
    splitcases `coeff d q = ring_0 (r:A ring)` [
      have `p (map0to d) = ring_0 (r:A ring)` [coeff] THEN
      have `q (map0to d) = ring_0 (r:A ring)` [coeff] THEN
      have `ring_neg (r:A ring) (q (map0to d)) = ring_0 r` [RING_NEG_0] THEN
      have `ring_add (r:A ring) (p (map0to d)) (ring_neg r (q (map0to d))) = ring_0 r` [RING_0;RING_ADD_LZERO] THEN
      qed[]
    ;
      qed[support_le_twodeg_le]
    ]
  ;
    qed[support_le_twodeg_le]
  ]
);;

let twodeg_sub_le = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  twodeg r q <= H ==>
  twodeg r (ring_sub(x_ring r) p q) <= H
`,
  intro THEN
  have `ring_sub(x_ring (r:A ring)) p q IN ring_carrier(x_ring r)` [RING_SUB] THEN
  have `!d. ~(coeff d (ring_sub(x_ring r) p q) = ring_0 (r:A ring)) ==> 2 EXP d <= H` [twodeg_sub_le_lemma] THEN
  qed[twodeg_le_if]
);;

let twodeg_sub_lt = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p < H ==>
  twodeg r q < H ==>
  twodeg r (ring_sub(x_ring r) p q) < H
`,
  intro THEN
  have `twodeg (r:A ring) p <= H-1` [le_minus_1_if_lt] THEN
  have `twodeg (r:A ring) q <= H-1` [le_minus_1_if_lt] THEN
  have `twodeg (r:A ring) (ring_sub(x_ring r) p q) <= H-1` [twodeg_sub_le] THEN
  have `H-1 < H:num` [minus_1_lt_if_lt] THEN
  qed[LET_TRANS]
);;

let twodeg_add_if_second_lt = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p = H ==>
  twodeg r q < H ==>
  twodeg r (ring_add(x_ring r) p q) = H
`,
  intro THEN
  have `twodeg (r:A ring) p <= H` [LE_REFL] THEN
  have `twodeg (r:A ring) q <= H` [LT_IMP_LE] THEN
  have `twodeg (r:A ring) (ring_add(x_ring r) p q) <= H` [twodeg_add_le] THEN
  handlecase `twodeg (r:A ring) (ring_add(x_ring r) p q) < H` (
    have `ring_add(x_ring (r:A ring)) p q IN ring_carrier(x_ring r)` [RING_ADD] THEN
    have `p = ring_sub(x_ring (r:A ring)) (ring_add(x_ring r) p q) q` [ring_add_sub_cancel2] THEN
    have `twodeg (r:A ring) p < H` [twodeg_sub_lt] THEN
    qed[LT_REFL]
  ) THEN
  qed[LE_LT]
);;

let twodeg_sub_if_second_lt = prove(`
  !(r:A ring) p q H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p = H ==>
  twodeg r q < H ==>
  twodeg r (ring_sub(x_ring r) p q) = H
`,
  intro THEN
  have `twodeg (r:A ring) p <= H` [LE_REFL] THEN
  have `twodeg (r:A ring) q <= H` [LT_IMP_LE] THEN
  have `twodeg (r:A ring) (ring_sub(x_ring r) p q) <= H` [twodeg_sub_le] THEN
  handlecase `twodeg (r:A ring) (ring_sub(x_ring r) p q) < H` (
    have `ring_sub(x_ring (r:A ring)) p q IN ring_carrier(x_ring r)` [RING_SUB] THEN
    have `p = ring_add(x_ring (r:A ring)) (ring_sub(x_ring r) p q) q` [ring_sub_add_cancel] THEN
    have `twodeg (r:A ring) p < H` [twodeg_add_lt] THEN
    qed[LT_REFL]
  ) THEN
  qed[LE_LT]
);;

let twodeg_neg_lemma = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  twodeg r (ring_neg(x_ring r) p) <= twodeg r p
`,
  intro THEN
  have `ring_neg(x_ring(r:A ring)) p = ring_sub(x_ring r) (poly_0 r) p` [RING_RULE `ring_neg(r:A ring) p = ring_sub r (ring_0 r) p`;x_ring_0] THEN
  have `poly_0(r:A ring) IN ring_carrier(x_ring r)` [x_ring_0;RING_0] THEN
  have `twodeg(r:A ring) (poly_0 r) = 0` [twodeg_0] THEN
  num_linear `twodeg(r:A ring) (poly_0 r) = 0 ==> twodeg(r:A ring) (poly_0 r) <= twodeg r p` THEN
  have `twodeg(r:A ring) p <= twodeg r p` [LE_REFL] THEN
  qed[twodeg_sub_le]
);;

let twodeg_neg = prove(`
  !(r:A ring) p.
  p IN ring_carrier(x_ring r) ==>
  twodeg r (ring_neg(x_ring r) p) = twodeg r p
`,
  intro THEN
  have `twodeg(r:A ring) (ring_neg(x_ring r) p) <= twodeg r p` [twodeg_neg_lemma] THEN
  have `ring_neg(x_ring(r:A ring)) p IN ring_carrier(x_ring r)` [RING_NEG] THEN
  have `twodeg(r:A ring) (ring_neg(x_ring r) (ring_neg(x_ring r) p)) <= twodeg r (ring_neg(x_ring r) p)` [twodeg_neg_lemma] THEN
  have `ring_neg(x_ring(r:A ring)) (ring_neg(x_ring r) p) = p` [RING_NEG_NEG] THEN
  qed[LE_ANTISYM]
);;

let twodeg_mul_le_lemma1 = prove(`
  !(r:A ring) p q G H d ab.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= G ==>
  twodeg r q <= H ==>
  ab IN {a,b | a+b = d} ==>
  (\(a,b). ring_mul r (coeff a p) (coeff b q)) ab IN ring_carrier r ==>
  ~((\(a,b). ring_mul r (coeff a p) (coeff b q)) ab = ring_0 r) ==>
  2 EXP d <= G*H
`,
  rw[IN_ELIM_THM] THEN
  intro THEN
  ASSUME_TAC(ISPECL[`\a b. ring_mul (r:A ring) (coeff a p) (coeff b q)`;`a:num`;`b:num`]lambda_pair_apply) THEN
  have `ring_mul (r:A ring) (coeff a p) (coeff b q) IN ring_carrier r` [] THEN
  have `~(ring_mul (r:A ring) (coeff a p) (coeff b q) = ring_0 r)` [] THEN
  have `coeff a p IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `coeff b q IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `~(coeff a p = ring_0 (r:A ring))` [ring_nonzero_if_mul_nonzero] THEN
  have `~(coeff b q = ring_0 (r:A ring))` [ring_nonzero_if_mul_nonzero] THEN
  have `2 EXP a <= twodeg (r:A ring) p` [support_le_twodeg] THEN
  have `2 EXP b <= twodeg (r:A ring) q` [support_le_twodeg] THEN
  have `2 EXP a <= G` [LE_TRANS] THEN
  have `2 EXP b <= H` [LE_TRANS] THEN
  have `(2 EXP a) * (2 EXP b) <= G*H` [LE_MULT2] THEN
  qed[EXP_ADD]
);;

let twodeg_mul_le_lemma2 = prove(`
  !(r:A ring) p q G H d.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= G ==>
  twodeg r q <= H ==>
  ~(coeff d (ring_mul(x_ring r) p q) = ring_0 r) ==>
  2 EXP d <= G*H
`,
  intro THEN
  have `ring_mul (x_ring (r:A ring)) = poly_mul r` [x_ring_mul] THEN
  have `~(coeff d (poly_mul r (p:(num->num)->A) q) = ring_0 (r:A ring))` [] THEN
  have `~(ring_sum(r) {a,b | a+b = d} (\(a,b). ring_mul r (coeff a p) (coeff b q)) = ring_0 (r:A ring))` [coeff_mul_poly] THEN
  choose `ab:num#num` `ab IN {a,b | a+b = d} /\ (\(a,b). ring_mul (r:A ring) (coeff a p) (coeff b q)) ab IN ring_carrier r /\ ~(((\(a,b). ring_mul r (coeff a p) (coeff b q))) ab = ring_0 r)` [ring_sum_nonzero] THEN
  qed[twodeg_mul_le_lemma1]
);;

let twodeg_mul_le = prove(`
  !(r:A ring) p q G H.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= G ==>
  twodeg r q <= H ==>
  twodeg r (ring_mul(x_ring r) p q) <= G*H
`,
  intro THEN
  have `!d. ~(coeff d (ring_mul(x_ring r) p q) = ring_0 (r:A ring)) ==> 2 EXP d <= G*H` [twodeg_mul_le_lemma2] THEN
  have `ring_mul(x_ring(r:A ring)) p q IN ring_carrier(x_ring r)` [RING_MUL] THEN
  qed[twodeg_le_if]
);;

let twodeg_mul_le_lt_twopow = prove(`
  !(r:A ring) p q d e.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= 2 EXP d ==>
  twodeg r q < 2 EXP e ==>
  twodeg r (ring_mul(x_ring r) p q) < 2 EXP (d+e)
`,
  intro THEN
  have `twodeg (r:A ring) q <= (2 EXP e) - 1` [le_minus_1_if_lt] THEN
  have `twodeg (r:A ring) (ring_mul(x_ring r) p q) <= (2 EXP d) * ((2 EXP e) - 1)` [twodeg_mul_le] THEN
  have `(2 EXP d) * ((2 EXP e) - 1) < 2 EXP (d+e)` [twopow_mul_twopow_minus_1] THEN
  qed[LET_TRANS]
);;

let twodeg_mul_lt_le_twopow = prove(`
  !(r:A ring) p q d e.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p < 2 EXP d ==>
  twodeg r q <= 2 EXP e ==>
  twodeg r (ring_mul(x_ring r) p q) < 2 EXP (d+e)
`,
  qed[twodeg_mul_le_lt_twopow;ADD_SYM;RING_MUL_SYM]
);;

let coeff_twodeg_nonzero = prove(`
  !(r:A ring) p d.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p = 2 EXP d ==>
  ~(coeff d p = ring_0 r)
`,
  rw[twodeg] THEN
  intro_genonly THEN
  DISCH_TAC THEN
  DISCH_TAC THEN
  splitcases `(p:(num->num)->A) = poly_0 (r:A ring)` [
    have `2 EXP d = 0` [] THEN
    qed[EXP_EQ_0;ARITH_RULE `~(2 = 0)`]
  ;
    have `2 EXP d = 2 EXP (maximum (x_support (r:A ring) p))` [] THEN
    have `d = maximum (x_support (r:A ring) p)` [twopow_injective] THEN
    have `FINITE (x_support (r:A ring) p)` [finite_x_support] THEN
    have `~(x_support (r:A ring) p = {})` [empty_x_support] THEN
    have `(x_support (r:A ring) p) d` [maximum_finite_nonempty] THEN
    qed[x_support_apply]
  ]
);;

let twodeg_sub_lt_if_matching_lead_lemma = prove(`
  !(r:A ring) p q d e.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= 2 EXP d ==>
  twodeg r q <= 2 EXP d ==>
  coeff d p = coeff d q ==>
  ~(coeff e (ring_sub(x_ring r) p q) = ring_0 r) ==>
  2 EXP e <= 2 EXP d - 1
`,
  intro THEN
  have `ring_sub(x_ring(r:A ring)) p q IN ring_carrier(x_ring r)` [RING_SUB] THEN
  have `2 EXP e <= twodeg r (ring_sub(x_ring(r:A ring)) p q)` [support_le_twodeg] THEN
  have `twodeg r (ring_sub(x_ring(r:A ring)) p q) <= 2 EXP d` [twodeg_sub_le] THEN
  have `2 EXP e <= 2 EXP d` [LE_TRANS] THEN
  have `e <= d:num` [twopow_mono_le] THEN
  splitcases `e = d:num` [
    have `coeff e (ring_sub(x_ring (r:A ring)) p q) = ring_sub r (coeff e p) (coeff e q)` [coeff_sub] THEN
    have `coeff d p IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
    qed[ring_sub_cancel]
  ;
    have `e < d:num` [LE_LT] THEN
    qed[twopow_lt_minus1]
  ]
);;

let twodeg_sub_lt_if_matching_lead = prove(`
  !(r:A ring) p q d.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r p <= 2 EXP d ==>
  twodeg r q <= 2 EXP d ==>
  coeff d p = coeff d q ==>
  twodeg r (ring_sub(x_ring r) p q) < 2 EXP d
`,
  intro THEN
  have `2 EXP d - 1 < 2 EXP d` [twopow_minus_1_lt] THEN
  have `!e. ~(coeff e (ring_sub(x_ring (r:A ring)) p q) = ring_0 r) ==> 2 EXP e <= 2 EXP d - 1` [twodeg_sub_lt_if_matching_lead_lemma] THEN
  have `ring_sub(x_ring(r:A ring)) p q IN ring_carrier(x_ring r)` [RING_SUB] THEN
  have `twodeg r (ring_sub(x_ring(r:A ring)) p q) <= 2 EXP d - 1` [twodeg_le_if] THEN
  qed[LET_TRANS]
);;

let twodeg_without_lead_lt = prove(`
  !(r:A ring) p d.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p = 2 EXP d ==>
  twodeg r (ring_sub(x_ring r) p (const_x_pow r (coeff d p) d)) < 2 EXP d
`,
  intro THEN
  have `coeff d p IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `const_x_pow r (coeff d p) d IN ring_carrier(x_ring(r:A ring))` [const_x_pow_in_x_ring] THEN
  have `ring_sub(x_ring r) p (const_x_pow r (coeff d p) d) IN ring_carrier(x_ring(r:A ring))` [RING_SUB] THEN
  have `~(coeff d p = ring_0 (r:A ring))` [coeff_twodeg_nonzero] THEN
  have `twodeg (r:A ring) (const_x_pow r (coeff d p) d) = 2 EXP d` [twodeg_const_x_pow] THEN
  have `twodeg (r:A ring) (ring_sub(x_ring r) p (const_x_pow r (coeff d p) d)) <= 2 EXP d` [twodeg_sub_le;LE_REFL] THEN
  have `coeff d p = coeff d (const_x_pow (r:A ring) (coeff d p) d)` [coeff_const_x_pow] THEN
  qed[twodeg_sub_lt_if_matching_lead;LE_REFL]
);;

let twodeg_mul = prove(`
  !(r:A ring) p q.
  integral_domain r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r (ring_mul(x_ring r) p q)
  = twodeg r p * twodeg r q
`,
  intro THEN
  handlecase `p:(num->num)->A = poly_0 r` (
    have `ring_mul(x_ring(r:A ring)) p q = poly_0 r` [ring_0_mul;x_ring_0] THEN
    simp[twodeg_0] THEN
    ARITH_TAC
  ) THEN
  handlecase `q:(num->num)->A = poly_0 r` (
    have `ring_mul(x_ring(r:A ring)) p q = poly_0 r` [ring_mul_0;x_ring_0] THEN
    simp[twodeg_0] THEN
    ARITH_TAC
  ) THEN
  def `a:num` `maximum (x_support (r:A ring) p)` THEN
  def `b:num` `maximum (x_support (r:A ring) q)` THEN
  def `pa:A` `coeff a (p:(num->num)->A)` THEN
  def `qb:A` `coeff b (q:(num->num)->A)` THEN
  have `pa IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `qb IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `ring_mul (r:A ring) pa qb IN ring_carrier(r)` [RING_MUL] THEN
  def `paxa:(num->num)->A` `const_x_pow (r:A ring) pa a` THEN
  def `qbxb:(num->num)->A` `const_x_pow (r:A ring) qb b` THEN
  have `paxa IN ring_carrier(x_ring(r:A ring))` [const_x_pow_in_x_ring] THEN
  have `qbxb IN ring_carrier(x_ring(r:A ring))` [const_x_pow_in_x_ring] THEN
  have `ring_mul(x_ring r) = poly_mul(r:A ring)` [x_ring_mul] THEN
  have `ring_mul(x_ring r) paxa qbxb = const_x_pow (r:A ring) (ring_mul r pa qb) (a+b)` [const_x_pow_mul] THEN
  have `twodeg (r:A ring) p = 2 EXP a` [twodeg] THEN
  have `twodeg (r:A ring) q = 2 EXP b` [twodeg] THEN
  have `twodeg (r:A ring) q <= 2 EXP b` [LE_REFL] THEN
  have `~(pa = ring_0(r:A ring))` [coeff_twodeg_nonzero] THEN
  have `~(qb = ring_0(r:A ring))` [coeff_twodeg_nonzero] THEN
  have `~(ring_mul r pa qb = ring_0(r:A ring))` [integral_domain] THEN
  have `ring_sub(x_ring r) p paxa IN ring_carrier(x_ring(r:A ring))` [RING_SUB] THEN
  have `ring_sub(x_ring r) q qbxb IN ring_carrier(x_ring(r:A ring))` [RING_SUB] THEN
  have `ring_mul(x_ring r) paxa q IN ring_carrier(x_ring(r:A ring))` [RING_MUL] THEN
  have `ring_mul(x_ring r) paxa qbxb IN ring_carrier(x_ring(r:A ring))` [RING_MUL] THEN
  have `ring_mul(x_ring r) paxa (ring_sub(x_ring r) q qbxb) IN ring_carrier(x_ring(r:A ring))` [RING_MUL] THEN
  have `ring_mul(x_ring r) (ring_sub(x_ring r) p paxa) q IN ring_carrier(x_ring(r:A ring))` [RING_MUL] THEN
  have `twodeg (r:A ring) (ring_sub(x_ring r) p paxa) < 2 EXP a` [twodeg_without_lead_lt] THEN
  have `twodeg (r:A ring) (ring_sub(x_ring r) q qbxb) < 2 EXP b` [twodeg_without_lead_lt] THEN
  have `twodeg (r:A ring) paxa = 2 EXP a` [twodeg_const_x_pow] THEN
  have `twodeg (r:A ring) paxa <= 2 EXP a` [LE_REFL] THEN
  have `twodeg (r:A ring) qbxb = 2 EXP b` [twodeg_const_x_pow] THEN
  have `twodeg (r:A ring) (const_x_pow r (ring_mul r pa qb) (a+b)) = 2 EXP (a+b)` [twodeg_const_x_pow] THEN
  have `twodeg (r:A ring) (ring_mul(x_ring r) paxa qbxb) = 2 EXP (a+b)` [] THEN
  have `twodeg (r:A ring) (ring_mul(x_ring r) paxa (ring_sub(x_ring r) q qbxb)) < 2 EXP (a+b)` [twodeg_mul_le_lt_twopow] THEN
  have `twodeg (r:A ring) (ring_add(x_ring r) (ring_mul(x_ring r) paxa qbxb) (ring_mul(x_ring r) paxa (ring_sub(x_ring r) q qbxb))) = 2 EXP (a+b)` [twodeg_add_if_second_lt] THEN
  have `ring_mul(x_ring(r:A ring)) paxa q
    = ring_add(x_ring r)
        (ring_mul(x_ring r) paxa qbxb)
        (ring_mul(x_ring r) paxa (ring_sub(x_ring r) q qbxb))
        ` [prove(`!(r:A ring) a b c. a IN ring_carrier r ==> b IN ring_carrier r ==> c IN ring_carrier r ==> ring_mul r a b = ring_add r (ring_mul r a c) (ring_mul r a (ring_sub r b c))`,RING_TAC)] THEN
  have `twodeg (r:A ring) (ring_mul(x_ring r) paxa q) = 2 EXP (a+b)` [] THEN
  have `twodeg (r:A ring) (ring_mul(x_ring r) (ring_sub(x_ring r) p paxa) q) < 2 EXP (a+b)` [twodeg_mul_lt_le_twopow] THEN
  have `twodeg (r:A ring) (ring_add(x_ring r) (ring_mul(x_ring r) paxa q) (ring_mul(x_ring r) (ring_sub(x_ring r) p paxa) q)) = 2 EXP (a+b)` [twodeg_add_if_second_lt] THEN
  have `ring_mul(x_ring(r:A ring)) p q
    = ring_add(x_ring r)
        (ring_mul(x_ring r) paxa q)
        (ring_mul(x_ring r) (ring_sub(x_ring r) p paxa) q)
        ` [prove(`!(r:A ring) a b c. a IN ring_carrier r ==> b IN ring_carrier r ==> c IN ring_carrier r ==> ring_mul r a b = ring_add r (ring_mul r c b) (ring_mul r (ring_sub r a c) b)`,RING_TAC)] THEN
  have `twodeg (r:A ring) (ring_mul(x_ring r) p q) = 2 EXP (a+b)` [] THEN
  qed[EXP_ADD]
);;

let twodeg_product = prove(`
  !(r:A ring).
  integral_domain r ==>
  !f.
  !S:X->bool.
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  twodeg r (ring_product(x_ring r) S f)
  = nproduct S (\s. twodeg r (f s))
`,
  GEN_TAC THEN
  DISCH_TAC THEN
  GEN_TAC THEN
  have `~(ring_1 (r:A ring) = ring_0 r)` [integral_domain] THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  conjunction [
    rw[NPRODUCT_CLAUSES;RING_PRODUCT_CLAUSES;x_ring_1;twodeg_poly_1] THEN
    simp[ARITH_RULE `2 EXP 0 = 1`]
  ;
    intro THEN
    simp[NPRODUCT_CLAUSES;RING_PRODUCT_CLAUSES] THEN
    have `!s:X. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN
    have `!s:X. s IN S ==> f s IN ring_carrier(x_ring(r:A ring))` [] THEN
    have `(x:X) IN x INSERT S` [IN_INSERT] THEN
    have `f(x:X) IN ring_carrier(x_ring(r:A ring))` [] THEN
    have `ring_product(x_ring(r:A ring)) (S:X->bool) f IN ring_carrier(x_ring r)` [RING_PRODUCT] THEN
    simp[twodeg_mul]
  ]
);;

let twodeg_pow = prove(`
  !(r:R ring) p n.
  integral_domain r ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r (ring_pow(x_ring r) p n)
  = twodeg r p EXP n
`,
  GEN_TAC THEN
  GEN_TAC THEN
  INDUCT_TAC THENL [
    simp[RING_POW_0;EXP;x_ring_1;twodeg_poly_1;integral_domain]
  ;
    simp[ring_pow;EXP;twodeg_mul;RING_POW]
  ]
);;

let twodeg_mul_ge = prove(`
  !(r:R ring) a b.
  integral_domain r ==>
  a IN ring_carrier(x_ring r) ==>
  b IN ring_carrier(x_ring r) ==>
  ~(a = poly_0 r) ==>
  twodeg r b <= twodeg r (ring_mul(x_ring r) a b)
`,
  intro THEN
  have `~(twodeg(r:R ring) a = 0)` [twodeg_only_0] THEN
  num_linear `~(twodeg(r:R ring) a = 0) ==> 1 <= twodeg(r:R ring) a` THEN
  have `twodeg(r:R ring) (ring_mul(x_ring r) a b) = twodeg r a * twodeg r b` [twodeg_mul] THEN
  have `1 * twodeg(r:R ring) b <= twodeg r a * twodeg r b` [LE_MULT2;LE_REFL] THEN
  ASM_ARITH_TAC
);;

(* should reuse twodeg_mul_ge here *)
let twodeg_divides_le = prove(`
  !(r:A ring) p q.
  integral_domain r ==>
  ring_divides(x_ring r) p q ==>
  ~(q = poly_0 r) ==>
  twodeg r p <= twodeg r q
`,
  intro THEN
  choose `f:(num->num)->A` `f IN ring_carrier(x_ring r) /\ ring_mul(x_ring(r:A ring)) p f = q` [ring_divides] THEN
  have `p IN ring_carrier(x_ring(r:A ring))` [ring_divides] THEN
  have `q IN ring_carrier(x_ring(r:A ring))` [ring_divides] THEN
  have `twodeg (r:A ring) q = twodeg r p * twodeg r f` [twodeg_mul] THEN
  have `~(twodeg (r:A ring) q = 0)` [twodeg_only_0] THEN
  have `~(twodeg (r:A ring) f = 0)` [MULT_0] THEN
  have `1 <= twodeg (r:A ring) f` [ARITH_RULE `~(f = 0) ==> 1 <= f`] THEN
  have `twodeg(r:A ring) p <= twodeg r p` [LE_REFL] THEN
  have `twodeg(r:A ring) p * 1 <= twodeg r p * twodeg r f` [LE_MULT2] THEN
  qed[ARITH_RULE `p * 1 = p`]
);;

let zero_if_twodeg_mul_lt_twodeg = prove(`
  !(r:R ring) p q.
  integral_domain r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  twodeg r (ring_mul(x_ring r) p q) < twodeg r q ==>
  p = poly_0 r
`,
  intro THEN
  have `twodeg(r:R ring) (ring_mul(x_ring r) p q) = twodeg r p * twodeg r q` [twodeg_mul] THEN
  have `twodeg(r:R ring) p = 0` [zero_if_mul_lt] THEN
  qed[twodeg_only_0]
);;

let twodeg_pow_le = prove(`
  !(r:R ring) p H n.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  twodeg r (ring_pow(x_ring r) p n) <= H EXP n
`,
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  INDUCT_TAC THENL [
    rw[RING_POW_0;EXP;x_ring_1;twodeg_poly_1] THEN
    qed[ARITH_RULE `0 <= 1 /\ 1 <= 1`]
  ;
    rw[ring_pow;EXP] THEN
    qed[twodeg_mul_le;RING_POW]
  ]
);;

(* ----- x_ring is euclidean *)

let x_ring_euclidean = prove(`
  !(k:K ring).
  field k ==>
  euclidean_ring(x_ring k)
`,
  intro THEN
  rw[EUCLIDEAN_RING] THEN
  EXISTS_TAC `twodeg(k:K ring)` THEN
  intro THEN
  have `ring_0(x_ring(k:K ring)) = poly_0 k` [x_ring_0] THEN
  have `~(b:(num->num)->K = poly_0(k:K ring))` [] THEN
  def `n:num` `maximum (x_support(k:K ring) b)` THEN
  have `twodeg(k:K ring) b = 2 EXP n` [twodeg] THEN
  have `~(twodeg(k:K ring) a = 0)` [ARITH_RULE `b <= 0 ==> b = 0`;twopow_nonzero] THEN
  def `m:num` `maximum (x_support(k:K ring) a)` THEN
  have `twodeg(k:K ring) a = 2 EXP m` [twodeg] THEN
  have `n <= m:num` [twopow_mono_le] THEN
  choose `d:num` `m = n + d:num` [LE_EXISTS] THEN
  have `coeff m a IN ring_carrier(k:K ring)` [coeff_in_ring] THEN
  have `coeff n b IN ring_carrier(k:K ring)` [coeff_in_ring] THEN
  have `ring_inv k (coeff n b) IN ring_carrier(k:K ring)` [RING_INV] THEN
  specialize_raw[`coeff m a:K`;`coeff n b:K`](RING_RULE `!a b. ring_mul(k:K ring) b (ring_inv k b) = ring_1 k ==> ring_mul k b (ring_mul k a (ring_inv k b)) = a`) THEN
  def `c:K` `ring_div(k:K ring) (coeff m a) (coeff n b)` THEN
  have `c IN ring_carrier(k:K ring)` [RING_DIV] THEN
  def `q:(num->num)->K` `const_x_pow(k:K ring) c d` THEN
  EXISTS_TAC `q:(num->num)->K` THEN
  conjunction [
    qed[const_x_pow_in_x_ring]
  ; pass
  ] THEN
  have `~(coeff m a = ring_0(k:K ring))` [lead_nonzero] THEN
  have `~(coeff n b = ring_0(k:K ring))` [lead_nonzero] THEN
  have `ring_mul (k:K ring) (coeff n b) (ring_inv k (coeff n b)) = ring_1 k` [FIELD_MUL_RINV] THEN
  have `ring_mul(k:K ring) (coeff n b) c = coeff m a` [ring_div] THEN
  have `~(c = ring_0(k:K ring))` [FIELD_DIV_EQ_0] THEN
  DISJ2_TAC THEN
  have `twodeg(k:K ring) q = 2 EXP d` [twodeg_const_x_pow] THEN
  have `q IN ring_carrier(x_ring(k:K ring))` [const_x_pow_in_x_ring] THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) b q) = twodeg k b * twodeg k q` [twodeg_mul] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) b q) = 2 EXP (n+d)` [EXP_ADD] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) b q) = 2 EXP m` [] THEN
  have `ring_mul(x_ring k) b q IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `coeff (d+n) (ring_mul(x_ring(k:K ring)) q b) = ring_mul k c (coeff n b)` [coeff_const_x_pow_times] THEN
  have `ring_mul(k:K ring) c (coeff n b) = coeff m a` [RING_MUL_SYM] THEN
  have `coeff m (ring_mul(x_ring(k:K ring)) q b) = coeff m a` [ADD_SYM] THEN
  have `coeff m a = coeff m (ring_mul(x_ring(k:K ring)) b q)` [RING_MUL_SYM] THEN
  specialize[`k:K ring`;`a:(num->num)->K`;`ring_mul(x_ring(k:K ring)) b q`;`m:num`]twodeg_sub_lt_if_lead_cancel THEN
  qed[]
);;

let x_ring_pid = prove(`
  !(k:K ring).
  field k ==>
  PID(x_ring k)
`,
  qed[x_ring_euclidean;EUCLIDEAN_DOMAIN_IMP_PID;FIELD_IMP_INTEGRAL_DOMAIN;x_ring_domain]
);;

let x_ring_bezout = prove(`
  !(k:K ring).
  field k ==>
  bezout_ring(x_ring k)
`,
  qed[x_ring_pid;PID_IMP_BEZOUT_RING]
);;

let x_ring_gcd = prove(`
  !(k:K ring) a b.
  field k ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  ?u v.
  u IN ring_carrier(x_ring k) /\
  v IN ring_carrier(x_ring k) /\
  ring_add(x_ring k)
    (ring_mul(x_ring k) a u)
    (ring_mul(x_ring k) b v)
  = ring_gcd(x_ring k) (a,b)
`,
  intro THEN
  have `bezout_ring(x_ring(k:K ring))` [x_ring_bezout] THEN
  qed[BEZOUT_RING_IMP_GCD]
);;

let x_ring_coprime = prove(`
  !(k:K ring) a b.
  field k ==>
  (ring_coprime(x_ring k) (a,b)
   <=> a IN ring_carrier(x_ring k)
    /\ b IN ring_carrier(x_ring k)
    /\ ?u v.
          u IN ring_carrier(x_ring k)
       /\ v IN ring_carrier(x_ring k)
       /\ ring_add(x_ring k)
           (ring_mul(x_ring k) a u)
           (ring_mul(x_ring k) b v)
         = poly_1 k
  )
`,
  intro THEN
  have `bezout_ring(x_ring(k:K ring))` [x_ring_bezout] THEN
  qed[BEZOUT_RING_COPRIME;x_ring_1]
);;

let x_ring_coprime_co1 = prove(`
  !(k:K ring) a b.
  field k ==>
  (ring_coprime(x_ring k) (a,b)
   <=> ring_co1(x_ring k) a b
  )
`,
  qed[x_ring_coprime;x_ring_1;ring_co1_add]
);;

let x_ring_gcd_nonzero = prove(`
  !(k:K ring) a b.
  field k ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  ~(a = poly_0 k /\ b = poly_0 k) ==>
  ~(ring_gcd(x_ring k) (a,b) = poly_0 k)
`,
  intro THEN
  def `g:(num->num)->K` `ring_gcd(x_ring(k:K ring)) (a,b)` THEN
  have `ring_divides(x_ring(k:K ring)) g a` [RING_GCD_DIVIDES] THEN
  choose `ag:(num->num)->K` `ag IN ring_carrier(x_ring k) /\ a = ring_mul(x_ring(k:K ring)) g ag` [ring_divides] THEN
  have `ring_divides(x_ring(k:K ring)) g b` [RING_GCD_DIVIDES] THEN
  choose `bg:(num->num)->K` `bg IN ring_carrier(x_ring k) /\ b = ring_mul(x_ring(k:K ring)) g bg` [ring_divides] THEN
  have `g = ring_0(x_ring(k:K ring))` [x_ring_0] THEN
  have `a = ring_0(x_ring(k:K ring))` [ring_0_mul] THEN
  have `b = ring_0(x_ring(k:K ring))` [ring_0_mul] THEN
  qed[x_ring_0]
);;

let x_ring_lowest_terms = prove(`
  !(k:K ring) a b.
  field k ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  ~(a = poly_0 k /\ b = poly_0 k) ==>
  ?ag bg.
     ag IN ring_carrier(x_ring k)
  /\ bg IN ring_carrier(x_ring k)
  /\ a = ring_mul(x_ring k) (ring_gcd(x_ring k) (a,b)) ag
  /\ b = ring_mul(x_ring k) (ring_gcd(x_ring k) (a,b)) bg
  /\ ring_coprime(x_ring k) (ag,bg)
`,
  intro THEN
  def `g:(num->num)->K` `ring_gcd(x_ring(k:K ring)) (a,b)` THEN
  have `~(g:(num->num)->K = poly_0 k)` [x_ring_gcd_nonzero] THEN
  have `ring_divides(x_ring(k:K ring)) g a` [RING_GCD_DIVIDES] THEN
  choose `ag:(num->num)->K` `ag IN ring_carrier(x_ring k) /\ a = ring_mul(x_ring(k:K ring)) g ag` [ring_divides] THEN
  EXISTS_TAC `ag:(num->num)->K` THEN
  have `ring_divides(x_ring(k:K ring)) g b` [RING_GCD_DIVIDES] THEN
  choose `bg:(num->num)->K` `bg IN ring_carrier(x_ring k) /\ b = ring_mul(x_ring(k:K ring)) g bg` [ring_divides] THEN
  EXISTS_TAC `bg:(num->num)->K` THEN
  choose_specializing `u:(num->num)->K`[`k:K ring`;`a:(num->num)->K`;`b:(num->num)->K`]x_ring_gcd THEN
  choose `v:(num->num)->K` `u IN ring_carrier(x_ring(k:K ring)) /\ v IN ring_carrier(x_ring k) /\ ring_add(x_ring k) (ring_mul(x_ring k) a u) (ring_mul(x_ring k) b v) = ring_gcd(x_ring k) (a,b)` [x_ring_gcd] THEN
  have `g IN ring_carrier(x_ring(k:K ring))` [RING_GCD] THEN
  have `ring_mul(x_ring(k:K ring)) g (ring_add(x_ring k) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v)) = ring_add(x_ring k) (ring_mul(x_ring k) (ring_mul(x_ring k) g ag) u) (ring_mul(x_ring k) (ring_mul(x_ring k) g bg) v)` [RING_RULE `ring_mul(r:R ring) g (ring_add r (ring_mul r ag u) (ring_mul r bg v)) = ring_add r (ring_mul r (ring_mul r g ag) u) (ring_mul r (ring_mul r g bg) v)`] THEN
  have `ring_mul(x_ring(k:K ring)) g (ring_add(x_ring k) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v)) = g` [] THEN
  have `g = ring_mul(x_ring(k:K ring)) g (ring_1(x_ring k))` [ring_mul_1] THEN
  have `ring_1(x_ring k) IN ring_carrier(x_ring(k:K ring))` [RING_1] THEN
  have `ring_mul(x_ring k) ag u IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) bg v IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_add(x_ring k) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v) IN ring_carrier(x_ring(k:K ring))` [RING_ADD] THEN
  have `ring_mul(x_ring(k:K ring)) g (ring_add(x_ring k) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v)) = ring_mul(x_ring(k:K ring)) g (ring_1(x_ring k))` [] THEN
  have `integral_domain(k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `integral_domain(x_ring(k:K ring))` [x_ring_domain] THEN
  have `~(g = ring_0(x_ring(k:K ring)))` [x_ring_0] THEN
  specialize_raw[`x_ring(k:K ring)`;`g:(num->num)->K`;`ring_add(x_ring(k:K ring)) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v)`;`ring_1(x_ring(k:K ring))`]INTEGRAL_DOMAIN_MUL_LCANCEL THEN
  have `ring_add(x_ring(k:K ring)) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v) = ring_1(x_ring k)` [] THEN
  have `ring_add(x_ring(k:K ring)) (ring_mul(x_ring k) ag u) (ring_mul(x_ring k) bg v) = poly_1 k` [x_ring_1] THEN
  qed[x_ring_coprime]
);;

let x_ring_lowest_terms_divides = prove(`
  !(k:K ring) a b c d.
  field k ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  c IN ring_carrier(x_ring k) ==>
  d IN ring_carrier(x_ring k) ==>
  ring_coprime(x_ring k) (a,b) ==>
  ring_mul(x_ring k) a d = ring_mul(x_ring k) b c ==>
  ?L.
     L IN ring_carrier(x_ring k)
  /\ c = ring_mul(x_ring k) a L
  /\ d = ring_mul(x_ring k) b L
`,
  intro THEN
  have `integral_domain(k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `integral_domain(x_ring(k:K ring))` [x_ring_domain] THEN
  have `bezout_ring(x_ring(k:K ring))` [x_ring_bezout] THEN
  simp[lowest_terms_divides]
);;

(* ----- poly_eval *)

let poly_eval = new_definition `
  poly_eval (r:R ring) (a:R)
  = poly_extend(r,r) I (\v:num. a)
`;;

let poly_eval_in_ring = prove(`
  !(r:A ring) a p.
  poly_eval r a p IN ring_carrier r
`,
  qed[poly_eval;POLY_EXTEND]
);;

let poly_eval_morphism = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  ring_homomorphism(x_ring r,r) (poly_eval r a)
`,
  intro THEN
  have `ring_homomorphism(r,r) (I:A->A)` [I_DEF;RING_HOMOMORPHISM_ID] THEN
  rw[poly_eval;x_ring] THEN
  qed[RING_HOMOMORPHISM_POLY_EXTEND]
);;

let poly_eval_0 = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  poly_eval r a (poly_0 r) = ring_0 r
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  have `ring_0(x_ring r) = poly_0 (r:A ring)` [x_ring_0] THEN
  qed[ring_homomorphism]
);;

let poly_eval_1 = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  poly_eval r a (poly_1 r) = ring_1 r
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  have `ring_1(x_ring r) = poly_1 (r:A ring)` [x_ring_1] THEN
  qed[ring_homomorphism]
);;

let poly_eval_neg = prove(`
  !(r:A ring) a p.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  poly_eval r a (ring_neg(x_ring r) p)
  = ring_neg(r) (poly_eval r a p)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  qed[RING_HOMOMORPHISM_NEG]
);;

let poly_eval_add = prove(`
  !(r:A ring) a p q.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_eval r a (ring_add(x_ring r) p q)
  = ring_add(r) (poly_eval r a p) (poly_eval r a q)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  qed[RING_HOMOMORPHISM_ADD]
);;

let poly_eval_sub = prove(`
  !(r:A ring) a p q.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_eval r a (ring_sub(x_ring r) p q)
  = ring_sub(r) (poly_eval r a p) (poly_eval r a q)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  qed[RING_HOMOMORPHISM_SUB]
);;

let poly_eval_mul = prove(`
  !(r:A ring) a p q.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_eval r a (ring_mul(x_ring r) p q)
  = ring_mul(r) (poly_eval r a p) (poly_eval r a q)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  qed[RING_HOMOMORPHISM_MUL]
);;

let poly_eval_pow = prove(`
  !(r:A ring) a p n.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  poly_eval r a (ring_pow(x_ring r) p n)
  = ring_pow(r) (poly_eval r a p) n
`,
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  INDUCT_TAC THENL [
    simp[RING_POW_0;x_ring_1;poly_eval_1]
  ;
    simp[ring_pow] THEN
    simp[poly_eval_mul;RING_POW]
  ]
);;

let poly_eval_sum = prove(`
  !(r:A ring) a (f:X->(num->num)->A) S.
  a IN ring_carrier r ==>
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  poly_eval r a (ring_sum(x_ring r) S f)
  = ring_sum r S ((poly_eval r a) o f)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  qed[RING_HOMOMORPHISM_SUM]
);;

let poly_eval_product = prove(`
  !(r:A ring) a (f:X->(num->num)->A) S.
  a IN ring_carrier r ==>
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  poly_eval r a (ring_product(x_ring r) S f)
  = ring_product r S ((poly_eval r a) o f)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,r) (poly_eval r (a:A))` [poly_eval_morphism] THEN
  qed[RING_HOMOMORPHISM_PRODUCT]
);;

let root_if_divides_root = prove(`
  !(r:R ring) p q c.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  ring_divides(x_ring r) p q ==>
  poly_eval r c p = ring_0 r ==>
  poly_eval r c q = ring_0 r
`,
  intro THEN
  choose `d:(num->num)->R` `d IN ring_carrier(x_ring(r:R ring)) /\ q = ring_mul(x_ring r) p d` [ring_divides] THEN
  have `poly_eval(r:R ring) c q = ring_mul r (poly_eval r c p) (poly_eval r c d)` [poly_eval_mul] THEN
  have `poly_eval(r:R ring) c d IN ring_carrier r` [poly_eval_in_ring] THEN
  qed[ring_0_mul]
);;

let poly_eval_const_x_pow = prove(`
  !(r:A ring) a c d.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_eval r a (const_x_pow r c d)
  = ring_mul r c (ring_pow r a d)
`,
  intro THEN
  have `ring_homomorphism(r,r) (I:A->A)` [I_DEF;RING_HOMOMORPHISM_ID] THEN
  have `{m | ~(const_x_pow r c d m = ring_0 (r:A ring))} SUBSET {map0to d}` [const_x_pow_monomials] THEN
  specialize[`{map0to d}`;`r:A ring`;`r:A ring`;`I:A->A`;`const_x_pow r (c:A) d`;`\v:num. a:A`]POLY_EXTEND_SUPERSET THEN
  rw[poly_eval] THEN
  simp[] THEN
  rw[RING_SUM_SING] THEN
  simp[const_x_pow_expand;I_THM] THEN
  rw[map0to_monomial_vars] THEN
  handlecase `d = 0` (
    simp[RING_PRODUCT_CLAUSES] THEN
    rw[RING_POW_0] THEN
    simp[RING_MUL_RID] 
  ) THEN
  simp[] THEN
  rw[RING_PRODUCT_SING] THEN
  have `map0to d 0 = d` [map0to] THEN
  have `ring_pow r (a:A) d IN ring_carrier r` [RING_POW] THEN
  have `ring_mul r c (ring_pow r (a:A) d) IN ring_carrier r` [RING_MUL] THEN
  simp[]
);;

let poly_eval_x_pow = prove(`
  !(r:A ring) a d.
  a IN ring_carrier r ==>
  poly_eval r a (x_pow r d)
  = ring_pow r a d
`,
  intro THEN
  rw[GSYM const_x_pow_1] THEN
  have `ring_1 (r:A ring) IN ring_carrier r` [RING_1] THEN
  simp[poly_eval_const_x_pow] THEN
  RING_TAC
);;

let poly_eval_x = prove(`
  !(r:A ring) a.
  a IN ring_carrier r ==>
  poly_eval r a (poly_x r)
  = a
`,
  rw[poly_x] THEN
  simp[poly_eval_x_pow;RING_POW_1]
);;

let poly_eval_const = prove(`
  !(r:A ring) a c.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_eval r a (poly_const r c)
  = c
`,
  simp[GSYM const_x_pow_deg0;poly_eval_const_x_pow;RING_POW_0] THEN
  RING_TAC
);;

let poly_eval_expand = prove(`
  !(r:A ring) a p.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  poly_eval r a p =
  ring_sum r
    (x_support r p)
    (\d. ring_mul r (coeff d p) (ring_pow r a d))
`,
  intro THEN
  have `p = ring_sum(x_ring(r:A ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d)` [x_ring_expand] THEN
  have `FINITE (x_support(r:A ring) p)` [finite_x_support] THEN
  have `!d. coeff d p IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `!d. d IN x_support(r:A ring) p ==> const_x_pow r (coeff d p) d IN ring_carrier(x_ring r)` [const_x_pow_in_x_ring] THEN
  specialize[`r:A ring`;`a:A`;`\d. const_x_pow (r:A ring) (coeff d p) d`;`x_support (r:A ring) p`]poly_eval_sum THEN
  have `poly_eval (r:A ring) a p = ring_sum r (x_support r p) (poly_eval r a o (\d. const_x_pow r (coeff d p) d))` [] THEN
  have_eqlambda `poly_eval (r:A ring) a o (\d. const_x_pow r (coeff d p) d) = (\d. ring_mul r (coeff d p) (ring_pow r a d))` [o_THM;poly_eval_const_x_pow] THEN
  qed[]
);;

let poly_eval_expand_superset_lemma = prove(`
  !(r:A ring) a p S.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  x_support r p SUBSET S ==>
  {d | d IN x_support r p /\ ~((\d. ring_mul r (coeff d p) (ring_pow r a d)) d = ring_0 r)}
  = {d | d IN S /\ ~((\d. ring_mul r (coeff d p) (ring_pow r a d)) d = ring_0 r)}
`,
  rw[x_support;EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  forwardreverse [
    STRIP_TAC THEN
    set_tac `!d. d IN {d | ~(coeff d p = ring_0 (r:A ring))} <=> ~(coeff d p = ring_0 r)` [] THEN
    have `(x:num) IN S` [SUBSET] THEN
    qed[];
    STRIP_TAC THEN
    have `ring_pow r (a:A) x IN ring_carrier r` [RING_POW] THEN
    have `coeff x p IN ring_carrier (r:A ring)` [coeff_in_ring] THEN
    qed[ring_nonzero_if_mul_nonzero]
  ]
);;

let poly_eval_expand_superset = prove(`
  !(r:A ring) a p S.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  x_support r p SUBSET S ==>
  poly_eval r a p =
  ring_sum r S (\d. ring_mul r (coeff d p) (ring_pow r a d))
`,
  intro THEN
  simp[poly_eval_expand] THEN
  once_rw[GSYM RING_SUM_SUPPORT] THEN
  simp[poly_eval_expand_superset_lemma]
);;

let poly_eval_expand_twodeg_le = prove(`
  !(r:R ring) a p H.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  poly_eval r a p =
  ring_sum r {d | 2 EXP d <= H} (\d. ring_mul r (coeff d p) (ring_pow r a d))
`,
  qed[poly_eval_expand_superset;support_subset_twodeg_le]
);;

let poly_eval_expand_twodeg_lt = prove(`
  !(r:R ring) a p H.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r p < H ==>
  poly_eval r a p =
  ring_sum r {d | 2 EXP d < H} (\d. ring_mul r (coeff d p) (ring_pow r a d))
`,
  qed[poly_eval_expand_superset;support_subset_twodeg_lt]
);;

let poly_eval_as_coeff = prove(`
  !(r:R ring) c p n.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r p < 2 EXP n ==>
  poly_eval r c p
  = coeff (n-1)
      (ring_mul(x_ring r)
         p
         (ring_sum(x_ring r)
            {d:num | d < n}
            (\d. const_x_pow r (ring_pow r c (n-1-d)) d)))
`,
  intro THEN
  ASM_CASES_TAC `n = 0` THENL [
    have `twodeg(r:R ring) p < 1` [ARITH_RULE `2 EXP 0 = 1`] THEN
    num_linear `twodeg(r:R ring) p < 1 ==> twodeg r p = 0` THEN
    have `p:(num->num)->R = poly_0 r` [twodeg_only_0] THEN
    have `poly_eval(r:R ring) c p = ring_0 r` [poly_eval_0] THEN
    simp[ring_0_mul;RING_SUM;GSYM x_ring_0] THEN
    simp[x_ring_0;coeff_0]
  ; pass
  ] THEN
  specialize[`r:R ring`;`c:R`;`p:(num->num)->R`;`2 EXP n`]poly_eval_expand_twodeg_lt THEN
  simp[] THEN
  rw[x_ring_mul] THEN
  simp[coeff_mul_poly_oneindex] THEN
  specialize[`n:num`]FINITE_NUMSEG_LT THEN
  have `!d. d IN {d | d < n} ==> const_x_pow r (ring_pow r c (n-1-d)) d IN ring_carrier(x_ring(r:R ring))` [const_x_pow_in_x_ring;RING_POW] THEN
  simp[coeff_sum] THEN
  simp[coeff_const_x_pow;RING_POW] THEN
  subgoal `!d. n-1-d IN {d | d < n}` THENL [
    rw[IN_ELIM_THM] THEN
    ASM_ARITH_TAC
  ; pass
  ] THEN
  subgoal `{d | 2 EXP d < 2 EXP n} = {d | d <= n-1}` THENL [
    rw[EXTENSION;IN_ELIM_THM] THEN
    qed[twopow_mono_lt;ARITH_RULE `~(n = 0) ==> (d < n <=> d <= n-1)`]
  ; pass
  ] THEN
  subgoal `!d. d IN {d | d <= n-1} ==> (n-1)-(n-1-d) = d` THENL [
    rw[IN_ELIM_THM] THEN
    num_linear `!d. d <= n-1 ==> (n-1)-(n-1-d) = d` THEN
    qed[]
  ; pass
  ] THEN
  simp[ring_sum_delta_flip_fun;RING_POW]
);;

let sum_poly_eval_as_coeff_sum = prove(`
  !(r:R ring) (S:X->bool) (f:X->R) p n (v:X->R).
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier r) ==>
  (!s. s IN S ==> v s IN ring_carrier r) ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r p < 2 EXP n ==>
  ring_sum r S (\s. ring_mul r (v s) (poly_eval r (f s) p))
  = coeff (n-1)
      (ring_mul(x_ring r)
         p
         (ring_sum(x_ring r)
            {d:num | d < n}
            (\d. const_x_pow r
                   (ring_sum r S (\s. ring_mul r (v s) (ring_pow r (f s) (n-1-d))))
                   d)))
`,
  intro THEN
  simp[poly_eval_as_coeff] THEN
  rw[x_ring_mul;coeff_mul_poly_oneindex] THEN
  specialize[`n-1`]FINITE_NUMSEG_LE THEN
  subgoal `!s:X. s IN S ==> ring_mul(r:R ring) (v s) (ring_sum r {a | a <= n - 1} (\a. ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))))) = ring_sum r {a | a <= n - 1} (\a. ring_mul r (v s) (ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))))` THENL [
    intro THEN
    have `!d:num. d IN {d | d <= n-1} ==> ring_mul(r:R ring) (coeff d p) (coeff (n - 1 - d) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f (s:X)) (n - 1 - d)) d))) IN ring_carrier(r:R ring)` [RING_MUL;coeff_in_ring;RING_SUM] THEN
    have `(v:X->R) s IN ring_carrier r` [] THEN
    specialize_raw[`r:R ring`;`\a. ring_mul(r:R ring) (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f (s:X)) (n - 1 - d)) d)))`;`(v:X->R) s`;`{a | a <= n-1}`](GSYM RING_SUM_LMUL) THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `ring_sum(r:R ring) S (\s:X. ring_sum r {a | a <= n - 1} (\a. ring_mul r (v s) (ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))))) = ring_sum r {a | a <= n - 1} (\a. ring_sum r S (\s:X.  ring_mul r (v s) (ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))))))` THENL [
    specialize_raw[`r:R ring`;`\s:X d:num. ring_mul r (v s) (ring_mul(r:R ring) (coeff d p) (coeff (n - 1 - d) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))))`;`S:X->bool`;`{d | d <= n-1}`]RING_SUM_SWAP THEN
    have `!s:X d:num. s IN S /\ d IN {d | d <= n-1} ==> ring_mul r (v s) (ring_mul r (coeff d p) (coeff (n - 1 - d) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))) IN ring_carrier(r:R ring)` [RING_MUL;coeff_in_ring;RING_SUM] THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `!a:num. a IN {a | a <= n-1} ==> ring_sum(r:R ring) S (\s:X. ring_mul r (v s) (ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))))) = ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_sum r S (\s. ring_mul r (v s) (ring_pow r (f s) (n - 1 - d)))) d)))` THENL [
    intro THEN
    subgoal `!d. const_x_pow(r:R ring) (ring_sum r S (\s:X. ring_mul r (v s) (ring_pow r (f s) (n - 1 - d)))) d = ring_sum(x_ring r) S (\s. const_x_pow r (ring_mul r (v s) (ring_pow r (f s) (n - 1 - d))) d)` THENL [
      intro THEN
      specialize_raw[`r:R ring`;`d:num`;`\s:X. ring_mul r (v s) (ring_pow(r:R ring) (f s) (n - 1 - d))`;`S:X->bool`]const_x_pow_sum THEN
      qed[RING_MUL;RING_POW]
    ; pass
    ] THEN
    simp[] THEN
    subgoal `!d s:X. s IN S ==> const_x_pow(r:R ring) (ring_mul r (v s) (ring_pow r (f s) (n - 1 - d))) d = ring_mul(x_ring r) (poly_const r (v s)) (const_x_pow r (ring_pow r (f s) (n-1-d)) d)` THENL [
      intro THEN
      rw[x_ring_mul] THEN
      have `(v:X->R) s IN ring_carrier r` [] THEN
      have `ring_pow(r:R ring) (f (s:X)) (n-1-d) IN ring_carrier r` [RING_POW] THEN
      simp[poly_const_mul_const_x_pow]
    ; pass
    ] THEN
    simp[] THEN
    have `!s:X. s IN S ==> ring_mul (r:R ring) (v s) (ring_mul r (coeff a p) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))) = ring_mul r (coeff a p) (ring_mul r (v s) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))))` [RING_RULE `ring_mul(r:R ring) V (ring_mul r A C) = ring_mul r A (ring_mul r V C)`;coeff_in_ring;RING_SUM] THEN
    simp[] THEN
    subgoal `ring_sum(r:R ring) S (\s:X. ring_mul r (coeff a p) (ring_mul r (v s) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))))) = ring_mul r (coeff a p) (ring_sum r S (\s. ring_mul r (v s) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))))` THENL [
      specialize_raw[`r:R ring`;`\s:X. ring_mul(r:R ring) (v s) (coeff (n - 1 - a) (ring_sum (x_ring r) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))`;`coeff a p:R`;`S:X->bool`]RING_SUM_LMUL THEN
      qed[coeff_in_ring;RING_MUL;RING_SUM]
    ; pass
    ] THEN
    simp[] THEN
    subgoal `ring_sum (x_ring(r:R ring)) {d | d < n} (\d. ring_sum (x_ring r) S (\s:X. ring_mul (x_ring r) (poly_const r (v s)) (const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))) = ring_sum (x_ring r) S (\s. ring_sum (x_ring r) {d | d < n} (\d. ring_mul (x_ring r) (poly_const r (v s)) (const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)))` THENL [
      specialize[`n:num`]FINITE_NUMSEG_LT THEN
      specialize_raw[`x_ring(r:R ring)`;`\d s:X. ring_mul (x_ring(r:R ring)) (poly_const r (v s)) (const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)`;`{d:num | d < n}`;`S:X->bool`]RING_SUM_SWAP THEN
      qed[RING_MUL;poly_const_in_x_ring;const_x_pow_in_x_ring;RING_POW]
    ; pass
    ] THEN
    simp[] THEN
    simp[coeff_sum;RING_SUM] THEN
    subgoal `!s. s IN S ==> ring_sum (x_ring(r:R ring)) {d | d < n} (\d. ring_mul (x_ring r) (poly_const r (v (s:X))) (const_x_pow r (ring_pow r (f s) (n - 1 - d)) d)) = ring_mul (x_ring r) (poly_const r (v s)) (ring_sum (x_ring(r:R ring)) {d | d < n} (\d. const_x_pow r (ring_pow r (f s) (n - 1 - d)) d))` THENL [
      intro THEN
      specialize_raw[`x_ring(r:R ring)`;`\d. const_x_pow(r:R ring) (ring_pow r (f (s:X)) (n - 1 - d)) d`;`poly_const(r:R ring) (v (s:X)):(num->num)->R`;`{d:num | d < n}`]RING_SUM_LMUL THEN
      qed[const_x_pow_in_x_ring;RING_POW;poly_const_in_x_ring;FINITE_NUMSEG_LT]
    ; pass
    ] THEN
    simp[] THEN
    simp[coeff_poly_const_times;RING_SUM]
  ; qed[RING_SUM_EQ]
  ]
);;

let poly_eval_at_0 = prove(`
  !(r:R ring) p.
  p IN ring_carrier(x_ring r) ==>
  poly_eval r (ring_0 r) p = coeff 0 p
`,
  intro THEN
  def `H:num` `twodeg(r:R ring) p + 1` THEN
  num_linear `twodeg(r:R ring) p <= twodeg(r:R ring) p + 1` THEN
  simp[poly_eval_expand_twodeg_le;RING_0] THEN
  specialize[`twodeg(r:R ring) p + 1`]twopow_finite THEN
  set_tac `0 IN {d | 2 EXP d <= twodeg(r:R ring) p + 1}` [ARITH_RULE `2 EXP 0 <= twodeg(r:R ring) p + 1`] THEN
  have `!d. ring_mul(r:R ring) (coeff d p) (ring_pow r (ring_0 r) d) IN ring_carrier r` [coeff_in_ring;RING_MUL;RING_POW;RING_0] THEN
  have `ring_mul(r:R ring) (coeff 0 p) (ring_pow r (ring_0 r) 0) IN ring_carrier r` [] THEN
  specialize[`r:R ring`;`{d | 2 EXP d <= twodeg(r:R ring) p + 1}`;`\d. ring_mul(r:R ring) (coeff d p) (ring_pow r (ring_0 r) d)`;`0`]ring_sum_delete2 THEN
  simp[] THEN
  simp[RING_POW_ZERO;ring_mul_1;coeff_in_ring] THEN
  subgoal `!d. d IN {d | 2 EXP d <= twodeg(r:R ring) p + 1} DELETE 0 ==> ring_mul r (coeff d p) (if d = 0 then ring_1 r else ring_0 r) = ring_0 r` THENL [
    intro THEN
    set_tac `d IN {d | 2 EXP d <= twodeg(r:R ring) p + 1} DELETE 0 ==> ~(d = 0)` [] THEN
    qed[ring_mul_0;coeff_in_ring]
  ;
    simp[RING_SUM_EQ_0;ring_add_0;coeff_in_ring]
  ]
);;

(* ----- x_plus_const *)

let x_plus_const = new_definition `
  x_plus_const (r:R ring) (c:R)
  = poly_add r (poly_x r) (poly_const r c)
`;;

let x_plus_const_in_x_ring = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  x_plus_const r c IN ring_carrier(x_ring r)
`,
  intro THEN
  have `poly_const r (c:A) IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `poly_x (r:A ring) IN ring_carrier(x_ring r)` [x_in_x_ring] THEN
  rw[x_plus_const] THEN
  qed[x_ring_add;RING_ADD]
);;

let twodeg_x_plus_const = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  twodeg r (x_plus_const r c)
  = if ring_1 r = ring_0 r then 0 else 2 EXP 1
`,
  intro THEN
  rw[x_plus_const] THEN
  have `poly_add (r:A ring) = ring_add(x_ring r)` [x_ring_add] THEN
  have `poly_const r (c:A) IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `poly_x (r:A ring) IN ring_carrier(x_ring r)` [x_in_x_ring] THEN
  have `poly_add (r:A ring) (poly_x r) (poly_const r c) IN ring_carrier(x_ring r)` [RING_ADD] THEN
  handlecase `ring_1 (r:A ring) = ring_0 r` (
    qed[twodeg_qedring]
  ) THEN
  simp[] THEN
  have `twodeg (r:A ring) (poly_x r) = 2 EXP 1` [twodeg_x] THEN
  have `twodeg (r:A ring) (poly_const r c) = if c = ring_0 r then 0 else 2 EXP 0` [twodeg_poly_const] THEN
  num_linear `0 < 2 EXP 1` THEN
  num_linear `2 EXP 0 < 2 EXP 1` THEN
  qed[twodeg_add_if_second_lt]
);;

let eval_x_plus_const = prove(`
  !(r:A ring) c a.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_eval r a (x_plus_const r c)
  = ring_add r a c
`,
  intro THEN
  have `poly_x (r:A ring) IN ring_carrier(x_ring r)` [x_in_x_ring] THEN
  have `poly_const (r:A ring) c IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  rw[x_plus_const] THEN
  have `poly_add (r:A ring) = ring_add(x_ring r)` [x_ring_add] THEN
  simp[poly_eval_add;poly_eval_x;poly_eval_const]
);;

(* ----- x_minus_const *)

let x_minus_const = new_definition `
  x_minus_const (r:R ring) (c:R)
  = ring_sub(x_ring r) (poly_x r) (poly_const r c)
`;;

let x_minus_const_0 = prove(`
  !(r:R ring).
  x_minus_const r (ring_0 r) = poly_x r
`,
  qed[x_minus_const;poly_0;x_ring_0;RING_SUB_RZERO;x_in_x_ring]
);;

let x_minus_const_as_plus = prove(`
  !(r:A ring) c.
  x_minus_const r c
  = x_plus_const r (ring_neg r c)
`,
  intro THEN
  rw[x_plus_const;x_minus_const] THEN
  have `poly_add r = ring_add (x_ring (r:A ring))` [x_ring_add] THEN
  have `poly_neg r = ring_neg (x_ring (r:A ring))` [x_ring_neg] THEN
  rw[POLY_CONST_NEG] THEN
  simp[ring_sub]
);;

let x_minus_const_in_x_ring = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  x_minus_const r c IN ring_carrier(x_ring r)
`,
  intro THEN
  rw[x_minus_const_as_plus] THEN
  have `ring_neg (r:A ring) c IN ring_carrier r` [RING_NEG] THEN
  simp[x_plus_const_in_x_ring]
);;

let twodeg_x_minus_const = prove(`
  !(r:A ring) c.
  c IN ring_carrier r ==>
  twodeg r (x_minus_const r c)
  = if ring_1 r = ring_0 r then 0 else 2 EXP 1
`,
  intro THEN
  rw[x_minus_const_as_plus] THEN
  have `ring_neg (r:A ring) c IN ring_carrier r` [RING_NEG] THEN
  simp[twodeg_x_plus_const]
);;

let eval_x_minus_const = prove(`
  !(r:A ring) c a.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_eval r a (x_minus_const r c)
  = ring_sub r a c
`,
  intro THEN
  rw[x_minus_const_as_plus] THEN
  have `ring_neg (r:A ring) c IN ring_carrier r` [RING_NEG] THEN
  simp[eval_x_plus_const] THEN
  RING_TAC
);;

(* ----- geometric_series *)

let geometric_series_lemma1 = prove(`
  !(r:A ring) a b n.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ring_mul r a (ring_mul r (ring_pow r a n) b)
  = ring_mul r (ring_pow r a (n+1)) b
  `,
  intro THEN
  have `ring_pow r a n IN ring_carrier(r:A ring)` [RING_POW] THEN
  qed[RING_MUL_ASSOC;ring_pow;ADD1]
);;

let geometric_series_lemma2 = prove(`
  !(r:A ring) a b n.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ring_mul r b (ring_mul r a (ring_pow r b n))
  = ring_mul r a (ring_pow r b (n+1))
  `,
  intro THEN
  have `ring_pow r b n IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `ring_pow r b (n+1) IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `ring_mul (r:A ring) a (ring_pow r b n) = ring_mul r (ring_pow r b n) a` [RING_MUL_SYM] THEN
  have `ring_mul (r:A ring) b (ring_mul r (ring_pow r b n) a) = ring_mul r (ring_pow r b (n+1)) a` [geometric_series_lemma1] THEN
  have `ring_mul (r:A ring) (ring_pow r b (n+1)) a = ring_mul r a (ring_pow r b (n+1))` [RING_MUL_SYM] THEN
  qed[]
);;

let geometric_series_lemma3 = prove(`
  !(r:A ring) a b d S.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  S = ring_sum r {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-1-i))) ==>
  ~(d = 0) ==>
  ring_mul r a S = ring_add r
    (ring_pow r a d)
    (ring_sum r {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))))
`,
  intro THEN
  have `FINITE {i:num | i < d}` [FINITE_NUMSEG_LT] THEN
  have `!i. ring_pow r a i IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `!i. ring_pow r b i IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `!i j. ring_mul r (ring_pow r a i) (ring_pow r b j) IN ring_carrier(r:A ring)` [RING_MUL] THEN
  specialize_raw[`r:A ring`;`\i. ring_mul(r:A ring) (ring_pow r a i) (ring_pow r b (d-1-i))`;`a:A`;`{i:num | i < d}`]RING_SUM_LMUL THEN
  have `!i j. ring_mul (r:A ring) a (ring_mul r (ring_pow r a i) (ring_pow r b j)) = ring_mul r (ring_pow r a (i+1)) (ring_pow r b j)` [geometric_series_lemma1] THEN
  have `ring_mul (r:A ring) a S = ring_sum r {i | i < d} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i)))` [RING_SUM_EQ] THEN
  have `d-1 IN {i | i < d}` [NUMSEG_LT;IN_NUMSEG_0;LE_REFL] THEN
  specialize_raw[`r:A ring`;`{i:num | i < d}`;`\i. ring_mul (r:A ring) (ring_pow r a (i+1)) (ring_pow r b (d-1-i))`;`d-1`]ring_sum_delete2 THEN
  have `ring_mul (r:A ring) a S = ring_add r
          (ring_mul r (ring_pow r a (d-1+1)) (ring_pow r b (d - 1 - (d - 1))))
          (ring_sum r ({i | i < d} DELETE (d - 1))
            (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d - 1 - i))))` [] THEN
  num_linear `~(d = 0) ==> d-1+1 = d` THEN
  have `ring_mul (r:A ring) a S = ring_add r
          (ring_mul r (ring_pow r a d) (ring_pow r b (d-1-(d-1))))
          (ring_sum r ({i | i < d} DELETE (d - 1))
            (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d - 1 - i))))` [] THEN
  num_linear `d-1-(d-1) = 0` THEN
  have `ring_mul (r:A ring) a S = ring_add r
          (ring_mul r (ring_pow r a d) (ring_pow r b 0))
          (ring_sum r ({i | i < d} DELETE (d - 1))
            (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d - 1 - i))))` [] THEN
  have `ring_pow (r:A ring) b 0 = ring_1 r` [RING_POW_0] THEN
  have `ring_mul (r:A ring) (ring_pow r a d) (ring_1 r) = ring_pow r a d` [ring_mul_1] THEN
  have `ring_mul (r:A ring) a S = ring_add r
          (ring_pow r a d)
          (ring_sum r ({i | i < d} DELETE (d - 1))
            (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d - 1 - i))))` [] THEN
  qed[range_delete_top]
);;

let geometric_series_lemma4 = prove(`
  !(r:A ring) a b d S.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  S = ring_sum r {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-1-i))) ==>
  ~(d = 0) ==>
  ring_mul r b S = ring_add r
    (ring_pow r b d)
    (ring_sum r {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))))
`,
  intro THEN
  have `FINITE {i:num | i < d}` [FINITE_NUMSEG_LT] THEN
  have `!i. ring_pow r a i IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `!i. ring_pow r b i IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `!i j. ring_mul r (ring_pow r a i) (ring_pow r b j) IN ring_carrier(r:A ring)` [RING_MUL] THEN
  specialize_raw[`r:A ring`;`\i. ring_mul(r:A ring) (ring_pow r a i) (ring_pow r b (d-1-i))`;`b:A`;`{i:num | i < d}`]RING_SUM_LMUL THEN
  have `!i j. ring_mul (r:A ring) b (ring_mul r (ring_pow r a i) (ring_pow r b j)) = ring_mul r (ring_pow r a i) (ring_pow r b (j+1))` [geometric_series_lemma2] THEN
  have `ring_mul (r:A ring) b S = ring_sum r {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-1-i+1)))` [RING_SUM_EQ] THEN
  set_tac `!i:num. i IN {i | i < d} ==> i < d` [] THEN
  have `!i. i IN {i | i < d} ==> d-1-i+1 = d-i` [ARITH_RULE `m < n ==> ((n-1)-m)+1 = n-m`] THEN
  have `!i. i IN {i | i < d} ==> ring_mul r (ring_pow r a i) (ring_pow (r:A ring) b (d-1-i+1)) = ring_mul r (ring_pow r a i) (ring_pow r b (d-i))` [] THEN
  have `ring_sum (r:A ring) {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-1-i+1))) = ring_sum r {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-i)))` [RING_SUM_EQ] THEN
  have `ring_mul (r:A ring) b S = ring_sum r {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-i)))` [] THEN
  have `0 IN {i | i < d}` [NUMSEG_LT;IN_NUMSEG_0;LE_0] THEN
  specialize_raw[`r:A ring`;`{i:num | i < d}`;`\i. ring_mul (r:A ring) (ring_pow r a i) (ring_pow r b (d-i))`;`0`]ring_sum_delete2 THEN
  have `ring_mul (r:A ring) b S = ring_add r (ring_mul r (ring_pow r a 0) (ring_pow r b (d-0))) (ring_sum r ({i | i < d} DELETE 0) (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-i))))` [] THEN
  have `ring_mul (r:A ring) (ring_pow r a 0) (ring_pow r b (d - 0)) = ring_mul (r:A ring) (ring_1 r) (ring_pow r b (d - 0))` [ring_pow] THEN
  have `ring_mul (r:A ring) (ring_1 r) (ring_pow r b (d - 0)) = ring_pow r b (d - 0)` [ring_1_mul] THEN
  have `ring_pow (r:A ring) b (d - 0) = ring_pow r b d` [ARITH_RULE `d-0=d`] THEN
  have `ring_mul (r:A ring) b S = ring_add r (ring_pow r b d) (ring_sum r ({i | i < d} DELETE 0) (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-i))))` [] THEN
  specialize[`r:A ring`;`d:num`;`\i. ring_mul(r:A ring) (ring_pow r a i) (ring_pow r b (d-i))`]ring_sum_range_delete_0 THEN
  have `ring_mul (r:A ring) b S = ring_add r (ring_pow r b d) (ring_sum r {j | j < d-1} (\j. ring_mul r (ring_pow r a (j+1)) (ring_pow r b (d-(j+1)))))` [] THEN
  set_tac `!j. j IN {j | j < d-1} ==> j < d-1` [] THEN
  have `!j. j IN {j | j < d-1} ==> d-(j+1) = d-1-j` [ARITH_RULE `j < d-1 ==> d-(j+1) = d-1-j`] THEN
  specialize_raw[`r:A ring`;`\j. ring_mul (r:A ring) (ring_pow r a (j+1)) (ring_pow r b (d-(j+1)))`;`\j. ring_mul (r:A ring) (ring_pow r a (j+1)) (ring_pow r b (d-1-j))`;`{j:num | j < d-1}`]RING_SUM_EQ THEN
  qed[]
);;

let geometric_series = prove(`
  !(r:A ring) a b d.
  a IN ring_carrier r ==>
  b IN ring_carrier r ==>
  ring_sub r (ring_pow r a d) (ring_pow r b d)
  = ring_mul r
      (ring_sub r a b)
      (ring_sum r {i | i < d}
        (\i. ring_mul r
               (ring_pow r a i)
               (ring_pow r b (d-1-i))))
`,
  intro THEN
  handlecase `d = 0` (
    havetac `{i:num | i < d} = {}` (rw[EXTENSION;EMPTY;IN_ELIM_THM] THEN qed[ARITH_RULE `~(i < 0)`]) THEN
    simp[RING_SUM_CLAUSES] THEN
    have `ring_sub (r:A ring) a b IN ring_carrier r` [RING_SUB] THEN
    simp[ring_mul_0;RING_POW_0;RING_SUB_REFL;RING_1]
  ) THEN
  def `S:A` `ring_sum (r:A ring) {i | i < d} (\i. ring_mul r (ring_pow r a i) (ring_pow r b (d-1-i)))` THEN
  have `ring_mul (r:A ring) a S = ring_add r (ring_pow r a d) (ring_sum r {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))))` [geometric_series_lemma3] THEN
  have `ring_mul (r:A ring) b S = ring_add r (ring_pow r b d) (ring_sum r {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))))` [geometric_series_lemma4] THEN
  have `S IN ring_carrier(r:A ring)` [RING_SUM] THEN
  have `ring_mul (r:A ring) (ring_sub r a b) S = ring_sub r (ring_mul (r:A ring) a S) (ring_mul (r:A ring) b S)` [RING_SUB_RDISTRIB] THEN
  have `ring_pow (r:A ring) a d IN ring_carrier r` [RING_POW] THEN
  have `ring_pow (r:A ring) b d IN ring_carrier r` [RING_POW] THEN
  have `ring_sum (r:A ring) {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))) IN ring_carrier r` [RING_SUM] THEN
  have `ring_sub (r:A ring) (ring_add r (ring_pow r a d) (ring_sum r {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))))) (ring_add r (ring_pow r b d) (ring_sum r {i | i < d-1} (\i. ring_mul r (ring_pow r a (i+1)) (ring_pow r b (d-1-i))))) = ring_sub r (ring_pow r a d) (ring_pow r b d)` [ring_sub_add_add_cancel] THEN
  qed[]
);;

let geometric_series_x_const = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  ring_sub(x_ring r) (x_pow r d) (poly_const r (ring_pow r c d))
  = ring_mul(x_ring r)
      (ring_sub(x_ring r) (poly_x r) (poly_const r c))
      (ring_sum(x_ring r) {i | i < d}
        (\i. ring_mul(x_ring r)
               (x_pow r i)
               (ring_pow(x_ring r) (poly_const r c) (d-1-i))))
`,
  intro THEN
  have `poly_x (r:A ring) IN ring_carrier(x_ring r)` [x_in_x_ring] THEN
  have `poly_const (r:A ring) c IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  specialize[`x_ring(r:A ring)`;`poly_x(r:A ring)`;`(poly_const(r:A ring) c):(num->num)->A`;`d:num`]geometric_series THEN
  rw[x_pow_is_pow_of_x] THEN
  simp[GSYM poly_const_pow] THEN
  qed[]
);;

let x_minus_const_divides_x_pow_minus_const_pow = prove(`
  !(r:A ring) c d.
  c IN ring_carrier r ==>
  ring_divides(x_ring r)
    (x_minus_const r c)
    (ring_sub(x_ring r) (x_pow r d) (poly_const r (ring_pow r c d)))
`,
  rw[ring_divides] THEN
  intro THENL [
    simp[x_minus_const_in_x_ring]
  ;
    have `ring_pow (r:A ring) c d IN ring_carrier r` [RING_POW] THEN
    have `poly_const r (ring_pow (r:A ring) c d) IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
    qed[x_pow_in_x_ring;RING_SUB]
  ;
    simp[geometric_series_x_const] THEN
    rw[x_minus_const] THEN
    EXISTS_TAC `ring_sum (x_ring(r:A ring)) {i | i < d} (\i. ring_mul (x_ring r) (x_pow r i) (ring_pow (x_ring r) (poly_const r c) (d - 1 - i)))` THEN
    qed[RING_SUM]
  ]
);;

let x_minus_const_divides_minus_eval = prove(`
  !(r:A ring) c p.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  ring_divides(x_ring r)
    (x_minus_const r c)
    (ring_sub(x_ring r) p (poly_const r (poly_eval r c p)))
`,
  intro THEN
  have `ring_sum (x_ring(r:A ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d) = p` [x_ring_expand] THEN
  have `ring_sum (r:A ring) (x_support r p) (\d. ring_mul r (coeff d p) (ring_pow r c d)) = poly_eval r c p` [poly_eval_expand] THEN
  have `!d. ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_sub(x_ring r) (x_pow r d) (poly_const r (ring_pow r c d)))` [x_minus_const_divides_x_pow_minus_const_pow] THEN
  have `!d. coeff d p IN ring_carrier(r:A ring)` [coeff_in_ring] THEN
  have `!d. poly_const(r:A ring) (coeff d p) IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `!d. ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_mul(x_ring r) (poly_const(r:A ring) (coeff d p)) (ring_sub(x_ring r) (x_pow r d) (poly_const r (ring_pow r c d))))` [RING_DIVIDES_LMUL] THEN
  have `!d. x_pow r d IN ring_carrier(x_ring(r:A ring))` [x_pow_in_x_ring] THEN
  have `!d. ring_pow r c d IN ring_carrier(r:A ring)` [RING_POW] THEN
  have `!d. poly_const r (ring_pow r c d) IN ring_carrier(x_ring(r:A ring))` [poly_const_in_x_ring] THEN
  have `!d. ring_mul(x_ring r) (poly_const(r:A ring) (coeff d p)) (ring_sub(x_ring r) (x_pow r d) (poly_const r (ring_pow r c d))) = ring_sub(x_ring r) (ring_mul(x_ring r) (poly_const r (coeff d p)) (x_pow r d)) (ring_mul(x_ring r) (poly_const r (coeff d p)) (poly_const r (ring_pow r c d)))` [RING_SUB_LDISTRIB] THEN
  have `!d. ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_sub(x_ring r) (ring_mul(x_ring r) (poly_const r (coeff d p)) (x_pow r d)) (ring_mul(x_ring r) (poly_const r (coeff d p)) (poly_const r (ring_pow r c d))))` [] THEN
  have `!d. ring_mul(x_ring(r:A ring)) (poly_const r (coeff d p)) (poly_const r (ring_pow r c d)) = poly_const r (ring_mul r (coeff d p) (ring_pow r c d))` [POLY_CONST_MUL;x_ring_mul] THEN
  have `!d. ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_sub(x_ring r) (ring_mul(x_ring r) (poly_const r (coeff d p)) (x_pow r d)) (poly_const r (ring_mul r (coeff d p) (ring_pow r c d))))` [] THEN
  have `!d. ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_sub(x_ring r) (const_x_pow r (coeff d p) d) (poly_const r (ring_mul r (coeff d p) (ring_pow r c d))))` [const_x_pow;x_ring_mul] THEN
  have `FINITE (x_support(r:A ring) p)` [finite_x_support] THEN
  have `!d. ring_mul r (coeff d p) (ring_pow r c d) IN ring_carrier(r:A ring)` [RING_MUL] THEN
  specialize_raw[`r:A ring`;`x_support(r:A ring) p`;`\d. ring_mul(r:A ring)  (coeff d p) (ring_pow r c d)`]poly_const_sum THEN
  have `poly_const(r:A ring) (ring_sum r (x_support r p) (\d. ring_mul r (coeff d p) (ring_pow r c d)))
    = ring_sum(x_ring r) (x_support r p) (\d. poly_const r (ring_mul r (coeff d p) (ring_pow r c d)))` [] THEN
  have `!d. const_x_pow r (coeff d p) d IN ring_carrier(x_ring(r:A ring))` [const_x_pow_in_x_ring] THEN
  have `!d. poly_const r (ring_mul r (coeff d p) (ring_pow r c d)) IN ring_carrier(x_ring(r:A ring))` [poly_const_in_x_ring] THEN
  specialize_raw[`x_ring(r:A ring)`;`\d. const_x_pow(r:A ring) (coeff d (p:(num->num)->A)) d`;`\d. (poly_const(r:A ring) (ring_mul r (coeff d (p:(num->num)->A)) (ring_pow r c d))):(num->num)->A`;`x_support(r:A ring) p`]ring_sum_sub THEN
  have `ring_sub(x_ring(r:A ring))
      (ring_sum(x_ring r) (x_support r p) (\d. const_x_pow r (coeff d p) d))
      (ring_sum(x_ring r) (x_support r p) (\d. poly_const r (ring_mul r (coeff d p) (ring_pow r c d))))
    = ring_sum(x_ring r) (x_support r p) (\d. ring_sub(x_ring r) (const_x_pow r (coeff d p) d) (poly_const r (ring_mul r (coeff d p) (ring_pow r c d))))
  ` [] THEN
  have `ring_sub(x_ring(r:A ring)) p (poly_const r (poly_eval r c p))
    = ring_sum(x_ring r) (x_support r p) (\d. ring_sub(x_ring r) (const_x_pow r (coeff d p) d) (poly_const r (ring_mul r (coeff d p) (ring_pow r c d))))` [] THEN
  have `x_minus_const(r:A ring) c IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  specialize_raw[`x_ring(r:A ring)`;`x_minus_const(r:A ring) c`;`x_support(r:A ring) p`;`\d. ring_sub(x_ring(r:A ring)) (const_x_pow r (coeff d p) d) (poly_const r (ring_mul r (coeff d p) (ring_pow r c d)))`]ring_divides_sum THEN
  have `ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_sum(x_ring r) (x_support r p) (\d. ring_sub(x_ring r) (const_x_pow r (coeff d p) d) (poly_const r (ring_mul r (coeff d p) (ring_pow r c d)))))` [] THEN
  qed[]
);;

let x_minus_const_divides_if_root = prove(`
  !(r:A ring) c p.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  poly_eval r c p = ring_0 r ==>
  ring_divides(x_ring r) (x_minus_const r c) p
`,
  intro THEN
  have `ring_divides(x_ring(r:A ring)) (x_minus_const r c) (ring_sub(x_ring r) p (poly_const r (poly_eval r c p)))` [x_minus_const_divides_minus_eval] THEN
  qed[poly_0;x_ring_0;RING_SUB_RZERO]
);;

let x_minus_const_co1_if_not_root = prove(`
  !(r:R ring) c p.
  field r ==>
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  ~(poly_eval r c p = ring_0 r) ==>
  ring_co1(x_ring r) p (x_minus_const r c)
`,
  intro THEN
  rw[ring_co1_sub] THEN
  choose `q:(num->num)->R` `q IN ring_carrier(x_ring r) /\ ring_sub(x_ring(r:R ring)) p (poly_const r (poly_eval r c p)) = ring_mul(x_ring(r:R ring)) (x_minus_const r c) q` [x_minus_const_divides_minus_eval;ring_divides] THEN
  def `i:R` `ring_inv(r:R ring) (poly_eval r c p)` THEN
  have `poly_eval(r:R ring) c p IN ring_carrier r` [poly_eval_in_ring] THEN
  have `ring_mul(r:R ring) (poly_eval r c p) i = ring_1 r` [FIELD_MUL_RINV] THEN
  have `i IN ring_carrier(r:R ring)` [RING_INV] THEN
  have `ring_mul(x_ring(r:R ring)) (poly_const r (poly_eval r c p)) (poly_const r i) = poly_1 r` [x_ring_mul;poly_1;POLY_CONST_MUL] THEN
  have `ring_mul(x_ring(r:R ring)) (poly_const r (poly_eval r c p)) (poly_const r i) = ring_1(x_ring r)` [x_ring_1] THEN
  have `x_minus_const(r:R ring) c IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  have `poly_const r (poly_eval r c p) IN ring_carrier(x_ring(r:R ring))` [poly_const_in_x_ring] THEN
  have `poly_const r i IN ring_carrier(x_ring(r:R ring))` [poly_const_in_x_ring] THEN
  have `ring_sub(x_ring(r:R ring)) (ring_mul(x_ring r) p (poly_const r i)) (ring_mul(x_ring r) (x_minus_const r c) (ring_mul(x_ring r) q (poly_const r i))) = ring_1(x_ring r)` [RING_RULE `ring_mul(a:A ring) E Z = ring_1 a ==> ring_mul a X Q = ring_sub a P E ==> ring_sub a (ring_mul a P Z) (ring_mul a X (ring_mul a Q Z)) = ring_1 a`] THEN
  simp[] THEN
  EXISTS_TAC `poly_const r i:(num->num)->R` THEN
  EXISTS_TAC `ring_mul(x_ring(r:R ring)) q (poly_const r i)` THEN
  have `ring_mul(x_ring(r:R ring)) q (poly_const r i) IN ring_carrier(x_ring r)` [RING_MUL] THEN
  qed[x_ring_1]
);;

let not_coprime_if_shared_root = prove(`
  !(r:R ring) p q c.
  integral_domain r ==>
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_eval r c p = ring_0 r ==>
  poly_eval r c q = ring_0 r ==>
  ~(ring_coprime(x_ring r) (p,q))
`,
  intro THEN
  have `ring_divides(x_ring(r:R ring)) (x_minus_const r c) p` [x_minus_const_divides_if_root] THEN
  have `ring_divides(x_ring(r:R ring)) (x_minus_const r c) q` [x_minus_const_divides_if_root] THEN
  have `ring_unit(x_ring(r:R ring)) (x_minus_const r c)` [ring_coprime] THEN
  choose `v:(num->num)->R` `v IN ring_carrier(x_ring r) /\ ring_mul(x_ring(r:R ring)) (x_minus_const r c) v = ring_1(x_ring(r:R ring))` [ring_unit] THEN
  have `ring_mul(x_ring(r:R ring)) (x_minus_const r c) v = poly_1 r` [x_ring_1] THEN
  have `x_minus_const(r:R ring) c IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  have `twodeg(r:R ring) (x_minus_const r c) * twodeg r v = twodeg r (poly_1 r)` [twodeg_mul] THEN
  have `twodeg(r:R ring) (x_minus_const r c) = 2 EXP 1` [twodeg_x_minus_const;integral_domain] THEN
  have `twodeg(r:R ring) (poly_const r (ring_1 r)) = 2 EXP 0` [twodeg_poly_const;RING_1;integral_domain] THEN
  have `twodeg(r:R ring) (poly_1 r) = 2 EXP 0` [poly_1] THEN
  have `2 EXP 1 * twodeg(r:R ring) v = 2 EXP 0` [] THEN
  qed[ARITH_RULE `2 EXP 0 = 1`;MULT_EQ_1;ARITH_RULE `~(2 EXP 1 = 1)`]
);;

(* ----- monic_vanishing_at *)

let monic_vanishing_at = new_definition `
  monic_vanishing_at (r:R ring) (S:R->bool)
  = ring_product(x_ring r)
      S (\s. x_minus_const r s)
`;;

let monic_vanishing_at_in_x_ring = prove(`
  !(r:A ring) S.
  monic_vanishing_at r S IN ring_carrier(x_ring r)
`,
  rw[monic_vanishing_at;RING_PRODUCT]
);;

let monic_vanishing_at_empty = prove(`
  !(r:A ring).
  monic_vanishing_at r {} = poly_1 r
`,
  simp[monic_vanishing_at;RING_PRODUCT_CLAUSES;x_ring_1]
);;

let monic_vanishing_at_insert = prove(`
  !(r:A ring) S t.
  t IN ring_carrier r ==>
  FINITE S ==>
  monic_vanishing_at r (t INSERT S)
  = if t IN S
    then monic_vanishing_at r S
    else ring_mul(x_ring r) (x_minus_const r t) (monic_vanishing_at r S)
`,
  rw[monic_vanishing_at] THEN
  intro THEN
  have `x_minus_const(r:A ring) t IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  simp[RING_PRODUCT_CLAUSES]
);;

let monic_vanishing_at_union = prove(`
  !(r:R ring) X Y U.
  U SUBSET ring_carrier r ==>
  U = X UNION Y ==>
  DISJOINT X Y ==>
  FINITE U ==>
  monic_vanishing_at r U
  = ring_mul(x_ring r)
      (monic_vanishing_at r X)
      (monic_vanishing_at r Y)
`,
  intro THEN
  have `FINITE(X:R->bool)` [FINITE_UNION] THEN
  have `FINITE(Y:R->bool)` [FINITE_UNION] THEN
  simp[monic_vanishing_at;RING_PRODUCT_UNION]
);;

(* non-integral-domain case would need twodeg_product_monic *)
let twodeg_monic_vanishing_at = prove(`
  !(r:A ring) S.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  twodeg r (monic_vanishing_at r S) = 2 EXP CARD S
`,
  intro THEN
  rw[monic_vanishing_at] THEN
  have `~(ring_1 (r:A ring) = ring_0 r)` [integral_domain] THEN
  have `!s:A. s IN S ==> s IN ring_carrier r` [SUBSET] THEN
  have `!s:A. s IN S ==> x_minus_const r s IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  simp[twodeg_product] THEN
  have `!s:A. s IN S ==> twodeg r (x_minus_const r s) = 2 EXP 1` [twodeg_x_minus_const] THEN
  simp[NPRODUCT_EQ;NPRODUCT_CONST] THEN
  rw[ARITH_RULE `2 EXP 1 = 2`]
);;

let monic_vanishing_at_nonzero = prove(`
  !(r:A ring) S.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  ~(monic_vanishing_at r S = poly_0 r)
`,
  qed[twodeg_monic_vanishing_at;twopow_nonzero;twodeg_0]
);;

let eval_monic_vanishing_at = prove(`
  !(r:A ring) S t.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  t IN ring_carrier r ==>
  poly_eval r t (monic_vanishing_at r S)
  = ring_product r S (\s. ring_sub r t s)
`,
  intro THEN
  have `!s:A. s IN S ==> s IN ring_carrier r` [SUBSET] THEN
  have `!s:A. s IN S ==> x_minus_const r s IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  rw[monic_vanishing_at] THEN
  simp[poly_eval_product] THEN
  have `!s:A. s IN S ==> ((poly_eval r t) o (\s. x_minus_const r s)) s = ring_sub r t s` [o_THM;eval_x_minus_const] THEN
  qed[RING_PRODUCT_EQ]
);;

let monic_vanishing_at_vanishes = prove(`
  !(r:A ring) S s.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  s IN S ==>
  poly_eval r s (monic_vanishing_at r S) = ring_0 r
`,
  intro THEN
  have `(s:A) IN ring_carrier r` [SUBSET] THEN
  simp[eval_monic_vanishing_at] THEN
  have `ring_sub (r:A ring) s s = ring_0 r` [RING_SUB_REFL] THEN
  qed[ring_product_0]
);;

let monic_vanishing_at_divides_if_roots_waterfall = prove(`
  !(r:A ring).
  integral_domain r ==>
  !S.
  FINITE S ==>
  S SUBSET ring_carrier r ==>
  !p.
  p IN ring_carrier(x_ring r) ==>
  (!s. s IN S ==> poly_eval r s p = ring_0 r) ==>
  ring_divides(x_ring r) (monic_vanishing_at r S) p
`,
  GEN_TAC THEN DISCH_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    rw[monic_vanishing_at_empty] THEN
    qed[RING_DIVIDES_1;x_ring_1]
  ;
    have `(x:A) IN x INSERT S` [IN_INSERT] THEN
    have `poly_eval(r:A ring) x p = ring_0 r` [] THEN
    have `(x:A) IN ring_carrier r` [SUBSET] THEN
    have `ring_divides(x_ring(r:A ring)) (x_minus_const r x) p` [x_minus_const_divides_if_root] THEN
    choose `q:(num->num)->A` `q IN ring_carrier(x_ring r) /\ (p:(num->num)->A) = ring_mul(x_ring r) (x_minus_const r x) q` [ring_divides] THEN
    have `!s:A. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN
    have `!s:A. s IN S ==> poly_eval r s p = ring_0 r` [] THEN
    have `x_minus_const(r:A ring) x IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
    have `!s:A. s IN S ==> s IN ring_carrier r` [SUBSET] THEN
    have `!s:A. s IN S ==> poly_eval r s (ring_mul(x_ring r) (x_minus_const r x) q) = ring_mul r (poly_eval r s (x_minus_const r x)) (poly_eval r s q)` [poly_eval_mul] THEN
    have `!s:A. s IN S ==> ring_mul r (poly_eval r s (x_minus_const r x)) (poly_eval r s q) = ring_0 r` [] THEN
    have `!s:A. s IN S ==> ring_mul r (ring_sub r s x) (poly_eval r s q) = ring_0 r` [eval_x_minus_const] THEN
    have `!s:A. s IN S ==> ~(s = x)` [] THEN
    have `!s:A. s IN S ==> ~(ring_sub r s x = ring_0 r)` [RING_SUB_EQ_0] THEN
    have `!s:A. s IN S ==> poly_eval r s q IN ring_carrier r` [poly_eval_in_ring] THEN
    have `!s:A. s IN S ==> ring_sub r s x IN ring_carrier r` [RING_SUB] THEN
    have `!s:A. s IN S ==> poly_eval r s q = ring_0 r` [integral_domain] THEN
    have `S SUBSET (x:A) INSERT S` [SUBSET] THEN
    have `S SUBSET ring_carrier(r:A ring)` [SUBSET_TRANS] THEN
    have `ring_divides(x_ring(r:A ring)) (monic_vanishing_at r S) q` [] THEN
    choose `f:(num->num)->A` `f IN ring_carrier(x_ring r) /\ (q:(num->num)->A) = ring_mul(x_ring r) (monic_vanishing_at r S) f` [ring_divides] THEN
    have `(p:(num->num)->A) = ring_mul(x_ring(r:A ring)) (x_minus_const r x) (ring_mul(x_ring r) (monic_vanishing_at r S) f)` [] THEN
    have `monic_vanishing_at(r:A ring) S IN ring_carrier(x_ring r)` [monic_vanishing_at_in_x_ring] THEN
    have `(p:(num->num)->A) = ring_mul(x_ring(r:A ring)) (ring_mul(x_ring r) (x_minus_const r x) (monic_vanishing_at r S)) f` [RING_MUL_ASSOC] THEN
    have `ring_mul(x_ring(r:A ring)) (x_minus_const r x) (monic_vanishing_at r S) = monic_vanishing_at r (x INSERT S)` [monic_vanishing_at_insert] THEN
    have `(p:(num->num)->A) = ring_mul(x_ring(r:A ring)) (monic_vanishing_at r (x INSERT S)) f` [] THEN
    have `monic_vanishing_at(r:A ring) (x INSERT S) IN ring_carrier(x_ring r)` [monic_vanishing_at_in_x_ring] THEN
    qed[ring_divides]
  ]
);;

let monic_vanishing_at_divides_if_roots = prove(`
  !(r:A ring) S p.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  p IN ring_carrier(x_ring r) ==>
  (!s. s IN S ==> poly_eval r s p = ring_0 r) ==>
  ring_divides(x_ring r) (monic_vanishing_at r S) p
`,
  qed[monic_vanishing_at_divides_if_roots_waterfall]
);;

(* with a bit more work can prove FINITE as conclusion *)
let roots_le_twodeg = prove(`
  !(r:A ring) S p.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  p IN ring_carrier(x_ring r) ==>
  (!s. s IN S ==> poly_eval r s p = ring_0 r) ==>
  ~(p = poly_0 r) ==>
  2 EXP CARD S <= twodeg r p
`,
  intro THEN
  have `ring_divides(x_ring(r:A ring)) (monic_vanishing_at r S) p` [monic_vanishing_at_divides_if_roots] THEN
  have `twodeg(r:A ring) (monic_vanishing_at r S) <= twodeg r p` [twodeg_divides_le] THEN
  qed[twodeg_monic_vanishing_at]
);;

let unit_if_divides_poly_1 = prove(`
  !(k:K ring) a.
  integral_domain k ==>
  ring_divides(x_ring k) a (poly_1 k) ==>
  ?u:K. u IN ring_carrier k /\ ring_unit k u /\ a = poly_const k u
`,
  intro THEN
  have `twodeg(k:K ring) (poly_1 k) = 2 EXP 0` [twodeg_poly_1;integral_domain] THEN
  have `~((poly_1 k):(num->num)->K = poly_0(k:K ring))` [twodeg_0;ARITH_RULE `~(0 = 2 EXP 0)`] THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [ring_divides] THEN
  have `twodeg(k:K ring) a <= 2 EXP 0` [twodeg_divides_le] THEN
  specialize[`k:K ring`;`a:(num->num)->K`;`2 EXP 0`]x_ring_expand_twodeg THEN
  subgoal `{d | 2 EXP d <= 2 EXP 0} = {0}` THENL [
    rw[EXTENSION;IN_SING;IN;setof_property_apply;twopow_mono_le] THEN
    ARITH_TAC
  ; pass
  ] THEN
  have `a = ring_sum(x_ring(k:K ring)) {0} (\d. const_x_pow k (coeff d a) d)` [] THEN
  have `coeff 0 a IN ring_carrier(k:K ring)` [coeff_in_ring] THEN
  have `const_x_pow(k:K ring) (coeff 0 a) 0 IN ring_carrier(x_ring k)` [const_x_pow_in_x_ring] THEN
  have `a = const_x_pow(k:K ring) (coeff 0 a) 0` [RING_SUM_SING] THEN
  have `a = poly_const (k:K ring) (coeff 0 a)` [const_x_pow_deg0] THEN
  EXISTS_TAC `coeff 0 a:K` THEN
  choose `b:(num->num)->K` `b IN ring_carrier(x_ring k) /\ poly_1(k:K ring) = ring_mul(x_ring k) a b` [ring_divides] THEN
  have `coeff 0 (poly_mul(k:K ring) a b) = ring_mul k (coeff 0 a) (coeff 0 b)` [coeff_mul_poly_deg0] THEN
  have `coeff 0 (ring_mul(x_ring(k:K ring)) a b) = ring_mul k (coeff 0 a) (coeff 0 b)` [x_ring_mul] THEN
  have `coeff 0 (poly_1(k:K ring)) = ring_1 k` [poly_1;coeff_poly_const;RING_1] THEN
  have `ring_mul(k:K ring) (coeff 0 a) (coeff 0 b) = ring_1 k` [] THEN
  have `coeff 0 b IN ring_carrier(k:K ring)` [coeff_in_ring] THEN
  qed[ring_unit]
);;

let unit_if_divides_monic_vanishing_at_without_roots_waterfall = prove(`
  !(k:K ring).
  field k ==>
  !S.
  FINITE S ==>
  !A a.
  S SUBSET ring_carrier k ==>
  A = monic_vanishing_at k S ==> 
  ring_divides(x_ring k) a A ==>
  (!s. s IN S ==> ~(poly_eval k s a = ring_0 k)) ==>
  ?u:K. u IN ring_carrier k /\ ring_unit k u /\ a = poly_const k u
`,
  GEN_TAC THEN DISCH_TAC THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    have `A:(num->num)->K = poly_1 k` [monic_vanishing_at_empty] THEN
    qed[unit_if_divides_poly_1]
  ;
    have `~(poly_eval(k:K ring) x a = ring_0 k)` [IN_INSERT] THEN
    have `(x:K) IN ring_carrier k` [IN_INSERT;SUBSET] THEN
    have `a IN ring_carrier(x_ring(k:K ring))` [ring_divides] THEN
    have `ring_co1(x_ring(k:K ring)) a (x_minus_const k x)` [x_minus_const_co1_if_not_root] THEN
    have `monic_vanishing_at k ((x:K) INSERT S) = ring_mul(x_ring k) (x_minus_const k x) (monic_vanishing_at k S)` [monic_vanishing_at_insert] THEN
    have `monic_vanishing_at k S IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
    have `x_minus_const (k:K ring) x IN ring_carrier(x_ring k)` [x_minus_const_in_x_ring] THEN
    have `ring_divides(x_ring(k:K ring)) a (monic_vanishing_at k S)` [ring_divides_if_divides_mul_co1] THEN
    have `S SUBSET (x:K) INSERT S` [SUBSET_INSERT;SUBSET_REFL] THEN
    have `S SUBSET ring_carrier(k:K ring)` [SUBSET_TRANS] THEN
    have `!s:K. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN
    have `!s:K. s IN S ==> ~(poly_eval k s a = ring_0 k)` [IN_INSERT] THEN
    qed[]
  ]
);;

let unit_if_divides_monic_vanishing_at_without_roots = prove(`
  !(k:K ring) S A a.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  ring_divides(x_ring k) a A ==>
  (!s. s IN S ==> ~(poly_eval k s a = ring_0 k)) ==>
  ?u:K. u IN ring_carrier k /\ ring_unit k u /\ a = poly_const k u
`,
  intro THEN
  specialize[`A:(num->num)->K`;`a:(num->num)->K`](UNDISCH(ISPECL[`S:K->bool`](UNDISCH(ISPECL[`k:K ring`]unit_if_divides_monic_vanishing_at_without_roots_waterfall)))) THEN
  qed[]
);;

let divides_monic_vanishing_at = prove(`
  !(k:K ring) S A a.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  ring_divides(x_ring k) a A ==>
  ?u:K.
       u IN ring_carrier k
    /\ ring_unit k u
    /\ a = ring_mul(x_ring k)
             (poly_const k u)
             (monic_vanishing_at k
                {s | s IN S /\ poly_eval k s a = ring_0 k})
`,
  intro THEN
  set_tac `!s:K. s IN {s:K | s IN S /\ poly_eval k s a = ring_0 k} <=> (s IN S /\ poly_eval k s a = ring_0 k)` [] THEN
  set_tac `!s:K. s IN {s:K | s IN S /\ ~(poly_eval k s a = ring_0 k)} <=> (s IN S /\ ~(poly_eval k s a = ring_0 k))` [] THEN
  set_tac `S = {s:K | s IN S /\ poly_eval k s a = ring_0 k} UNION {s:K | s IN S /\ ~(poly_eval k s a = ring_0 k)}` [] THEN
  def `X:K->bool` `{s:K | s IN S /\ poly_eval k s a = ring_0 k}` THEN
  def `Y:K->bool` `{s:K | s IN S /\ ~(poly_eval k s a = ring_0 k)}` THEN
  have `!s:K. s IN X <=> (s IN S /\ poly_eval k s a = ring_0 k)` [] THEN
  have `!s:K. s IN Y <=> (s IN S /\ ~(poly_eval k s a = ring_0 k))` [] THEN
  have `(S:K->bool) = X UNION Y` [] THEN
  have `DISJOINT X (Y:K->bool)` [IN_DISJOINT] THEN
  def `B:(num->num)->K` `monic_vanishing_at (k:K ring) X` THEN
  def `C:(num->num)->K` `monic_vanishing_at (k:K ring) Y` THEN
  have `A = ring_mul(x_ring(k:K ring)) B C` [monic_vanishing_at_union] THEN
  have `X SUBSET ring_carrier(k:K ring)` [SUBSET_UNION;SUBSET_TRANS] THEN
  have `FINITE(X:K->bool)` [SUBSET_UNION;FINITE_SUBSET] THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [ring_divides] THEN
  have `!s:K. s IN X ==> poly_eval k s a = ring_0 k` [] THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `ring_divides(x_ring(k:K ring)) B a` [monic_vanishing_at_divides_if_roots] THEN
  choose `aB:(num->num)->K` `aB IN ring_carrier(x_ring(k:K ring)) /\ a = ring_mul(x_ring k) B aB` [ring_divides] THEN
  choose `Aa:(num->num)->K` `Aa IN ring_carrier(x_ring(k:K ring)) /\ A = ring_mul(x_ring k) a Aa` [ring_divides] THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `B IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `C IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `integral_domain(x_ring(k:K ring))` [x_ring_domain] THEN
  have `ring_mul(x_ring(k:K ring)) B C = ring_mul(x_ring k) B (ring_mul(x_ring k) aB Aa)` [
    RING_RULE `a = ring_mul(r:R ring) B aB ==> A = ring_mul r a Aa ==> A = ring_mul r B C ==> ring_mul r B C = ring_mul r B (ring_mul r aB Aa)`
  ] THEN
  have `ring_mul(x_ring(k:K ring)) aB Aa IN ring_carrier(x_ring k)` [RING_MUL] THEN
  have `~(B:(num->num)->K = ring_0(x_ring k))` [monic_vanishing_at_nonzero;x_ring_0] THEN
  have `C = ring_mul(x_ring(k:K ring)) aB Aa` [INTEGRAL_DOMAIN_MUL_LCANCEL] THEN
  have `ring_divides(x_ring(k:K ring)) aB C` [ring_divides] THEN
  have `Y SUBSET ring_carrier(k:K ring)` [SUBSET_UNION;SUBSET_TRANS] THEN
  have `FINITE(Y:K->bool)` [SUBSET_UNION;FINITE_SUBSET] THEN
  subgoal `!s:K. s IN Y ==> ~(poly_eval k s aB = ring_0 k)` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `poly_eval(k:K ring) s a = ring_mul k (poly_eval k s B) (poly_eval k s aB)` [poly_eval_mul;x_ring_mul] THEN
    have `poly_eval(k:K ring) s B IN ring_carrier k` [poly_eval_in_ring] THEN
    qed[ring_mul_0]
  ; pass
  ] THEN
  specialize[`k:K ring`;`Y:K->bool`;`C:(num->num)->K`;`aB:(num->num)->K`]unit_if_divides_monic_vanishing_at_without_roots THEN
  qed[RING_MUL_SYM]
);;

let twodeg_if_divides_monic_vanishing_at = prove(`
  !(k:K ring) S A a.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  ring_divides(x_ring k) a A ==>
  twodeg k a = 2 EXP CARD {s | s IN S /\ poly_eval k s a = ring_0 k}
`,
  intro THEN
  choose `u:K` `u IN ring_carrier(k:K ring) /\ ring_unit k u /\ a = ring_mul(x_ring k) (poly_const k u) (monic_vanishing_at k {s | s IN S /\ poly_eval k s a = ring_0 k})` [divides_monic_vanishing_at] THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `monic_vanishing_at k {s:K | s IN S /\ poly_eval k s a = ring_0 k} IN ring_carrier(x_ring k)` [monic_vanishing_at_in_x_ring] THEN
  set_tac `{s:K | s IN S /\ poly_eval k s a = ring_0 k} SUBSET S` [] THEN
  have `{s:K | s IN S /\ poly_eval k s a = ring_0 k} SUBSET ring_carrier k` [SUBSET_TRANS] THEN
  have `FINITE {s:K | s IN S /\ poly_eval k s a = ring_0 k}` [FINITE_SUBSET] THEN
  have `twodeg k (monic_vanishing_at k {s:K | s IN S /\ poly_eval k s a = ring_0 k}) = 2 EXP CARD {s | s IN S /\ poly_eval k s a = ring_0 k}` [twodeg_monic_vanishing_at] THEN
  have `poly_const(k:K ring) u IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `twodeg(k:K ring) (poly_const k u) = 2 EXP 0` [twodeg_poly_const;RING_UNIT_0;INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING] THEN
  have `twodeg k a = twodeg k (poly_const k u) * twodeg k (monic_vanishing_at k {s:K | s IN S /\ poly_eval k s a = ring_0 k})` [twodeg_mul] THEN
  qed[ARITH_RULE `2 EXP 0 * H = H`]
);;

let nonzero_if_divides_monic_vanishing_at = prove(`
  !(k:K ring) S A a.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  ring_divides(x_ring k) a A ==>
  ~(a = poly_0 k)
`,
  intro THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `~(A:(num->num)->K = poly_0(k:K ring))` [monic_vanishing_at_nonzero] THEN
  qed[ring_nonzero_if_divides_nonzero;x_ring_0]
);;

let divides_if_roots_and_divides_monic_vanishing_at = prove(`
  !(k:K ring) S A a p.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  ring_divides(x_ring k) a A ==>
  p IN ring_carrier(x_ring k) ==>
  (!s. s IN S ==>
       poly_eval k s a = ring_0 k ==>
       poly_eval k s p = ring_0 k) ==>
  ring_divides(x_ring k) a p
`,
  intro THEN
  simp[ring_divides] THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [ring_divides] THEN
  set_tac `!s:K. s IN {s:K | s IN S /\ poly_eval k s a = ring_0 k} <=> (s IN S /\ poly_eval k s a = ring_0 k)` [] THEN
  def `X:K->bool` `{s:K | s IN S /\ poly_eval k s a = ring_0 k}` THEN
  have `!s:K. s IN X <=> (s IN S /\ poly_eval k s a = ring_0 k)` [] THEN
  have `X SUBSET (S:K->bool)` [SUBSET] THEN
  have `!s:K. s IN X ==> poly_eval k s a = ring_0 k` [] THEN
  have `!s:K. s IN X ==> poly_eval k s p = ring_0 k` [] THEN
  choose `u:K` `u IN ring_carrier k /\ ring_unit (k:K ring) u /\ a = ring_mul(x_ring k) (poly_const k u) (monic_vanishing_at k X)` [divides_monic_vanishing_at] THEN
  have `X SUBSET ring_carrier(k:K ring)` [SUBSET_TRANS] THEN
  have `FINITE(X:K->bool)` [FINITE_SUBSET] THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `ring_divides(x_ring(k:K ring)) (monic_vanishing_at k X) p` [monic_vanishing_at_divides_if_roots] THEN
  choose `q:(num->num)->K` `q IN ring_carrier(x_ring(k:K ring)) /\ p = ring_mul(x_ring k) (monic_vanishing_at k X) q` [ring_divides] THEN
  conjunction [ qed[]; pass ] THEN
  EXISTS_TAC `ring_mul(x_ring(k:K ring)) (poly_const k (ring_inv k u)) q` THEN
  have `ring_inv(k:K ring) u IN ring_carrier k` [RING_INV] THEN
  have `poly_const k (ring_inv(k:K ring) u) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `ring_mul(x_ring k) (poly_const k (ring_inv(k:K ring) u)) q IN ring_carrier(x_ring k)` [RING_MUL] THEN
  conjunction [ qed[]; pass ] THEN
  have `ring_mul(k:K ring) u (ring_inv k u) = ring_1 k` [RING_MUL_RINV] THEN
  have `poly_const(k:K ring) (ring_mul k u (ring_inv k u)) = ring_mul(x_ring k) (poly_const k u) (poly_const k (ring_inv k u))` [x_ring_mul;POLY_CONST_MUL] THEN
  have `ring_mul(x_ring k) (poly_const k u) (poly_const k (ring_inv k u)) = ring_1(x_ring(k:K ring))` [poly_1;x_ring_1] THEN
  have `poly_const k u IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
  have `poly_const k (ring_inv k u) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
  have `monic_vanishing_at k X IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `ring_mul(x_ring(k:K ring)) (poly_const k u) (poly_const k (ring_inv k u)) = ring_1(x_ring k) ==> p = ring_mul(x_ring k) (monic_vanishing_at k X) q ==> a = ring_mul(x_ring k) (poly_const k u) (monic_vanishing_at k X) ==> p = ring_mul(x_ring k) a (ring_mul(x_ring k) (poly_const k (ring_inv k u)) q)` [RING_RULE `ring_mul r u i = ring_1 r ==> p = ring_mul r m q ==> a = ring_mul r u m ==> p = ring_mul(r:R ring) a (ring_mul r i q)`] THEN
  qed[]
);;

(* ----- monic_vanishing_at_except *)

let monic_vanishing_at_except = new_definition `
  monic_vanishing_at_except (r:R ring) S s
  = monic_vanishing_at r (S DELETE s)
`;;

let monic_vanishing_at_except_in_x_ring = prove(`
  !(r:A ring) S s.
  monic_vanishing_at_except r S s IN ring_carrier(x_ring r)
`,
  rw[monic_vanishing_at_except;monic_vanishing_at_in_x_ring]
);;

let twodeg_monic_vanishing_at_except = prove(`
  !(r:A ring) S s.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  s IN S ==>
  twodeg r (monic_vanishing_at_except r S s) = 2 EXP (CARD S - 1)
`,
  intro THEN
  have `S DELETE s SUBSET ring_carrier(r:A ring)` [DELETE_SUBSET;SUBSET_TRANS] THEN
  have `FINITE (S DELETE (s:A))` [FINITE_DELETE] THEN
  rw[monic_vanishing_at_except] THEN
  have `CARD (S DELETE (s:A)) = CARD S - 1` [CARD_DELETE] THEN
  simp[twodeg_monic_vanishing_at]
);;

let twodeg_monic_vanishing_at_except_lt = prove(`
  !(r:A ring) S s.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  s IN S ==>
  twodeg r (monic_vanishing_at_except r S s) < 2 EXP CARD S
`,
  intro THEN
  simp[twodeg_monic_vanishing_at_except] THEN
  have `~((S:A->bool) = {})` [in_empty] THEN
  have `~(CARD (S:A->bool) = 0)` [CARD_EQ_0] THEN
  num_linear `~(CARD (S:A->bool) = 0) ==> CARD S - 1 < CARD S` THEN
  qed[twopow_mono_lt]
);;

let eval_monic_vanishing_at_except = prove(`
  !(r:A ring) S t.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  t IN S ==>
  poly_eval r t (monic_vanishing_at_except r S t)
  = ring_product r (S DELETE t) (\s. ring_sub r t s)
`,
  intro THEN
  have `(t:A) IN ring_carrier r` [SUBSET] THEN
  have `S DELETE (t:A) SUBSET ring_carrier r` [DELETE_SUBSET;SUBSET_TRANS] THEN
  have `FINITE (S DELETE (t:A))` [FINITE_DELETE] THEN
  rw[monic_vanishing_at_except] THEN
  simp[eval_monic_vanishing_at]
);;

let monic_vanishing_at_except_vanishes = prove(`
  !(r:A ring) S t u.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  t IN S ==>
  u IN S ==>
  ~(t = u) ==>
  poly_eval r u (monic_vanishing_at_except r S t)
  = ring_0 r
`,
  intro THEN
  have `(t:A) IN ring_carrier r` [SUBSET] THEN
  have `(u:A) IN ring_carrier r` [SUBSET] THEN
  have `S DELETE (t:A) SUBSET ring_carrier r` [DELETE_SUBSET;SUBSET_TRANS] THEN
  have `FINITE (S DELETE (t:A))` [FINITE_DELETE] THEN
  have `u IN S DELETE (t:A)` [IN_DELETE] THEN
  rw[monic_vanishing_at_except] THEN
  simp[monic_vanishing_at_vanishes]
);;

let eval_monic_vanishing_at_except_nonzero = prove(`
  !(r:A ring) S t.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  t IN S ==>
  ~(poly_eval r t (monic_vanishing_at_except r S t) = ring_0 r)
`,
  intro_genonly THEN
  DISCH_TAC THEN
  DISCH_TAC THEN
  DISCH_TAC THEN
  DISCH_TAC THEN
  have `!s:A. s IN S ==> s IN ring_carrier r` [SUBSET] THEN
  have `(t:A) IN ring_carrier r` [] THEN
  have `!s:A. s IN S ==> ~(s = t) ==> ~(ring_sub r t s = ring_0 r)` [RING_SUB_EQ_0] THEN
  have `!s:A. s IN S DELETE t ==> ~(ring_sub r t s = ring_0 r)` [IN_DELETE] THEN
  have `FINITE (S DELETE (t:A))` [FINITE_DELETE] THEN
  simp[eval_monic_vanishing_at_except] THEN
  qed[INTEGRAL_DOMAIN_PRODUCT_EQ_0]
);;

let missing_times_monic_vanishing_at_except = prove(`
  !(r:R ring) S t.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  t IN S ==>
  monic_vanishing_at r S
  = ring_mul(x_ring r) (x_minus_const r t) (monic_vanishing_at_except r S t)
`,
  intro THEN
  rw[monic_vanishing_at_except] THEN
  set_tac `~((t:R) IN (S DELETE t))` [] THEN
  set_tac `(t:R) IN S ==> t INSERT (S DELETE t) = S` [] THEN
  have `(t:R) IN ring_carrier r` [SUBSET] THEN
  have `FINITE (S DELETE (t:R))` [FINITE_DELETE] THEN
  qed[monic_vanishing_at_insert]
);;

(* should factor this out of the twodeg_interpolator proof *)
let twodeg_sum_monic_vanishing_at_except = prove(`
  !(r:R ring) S v.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  (!s. s IN S ==> v s IN ring_carrier r) ==>
  twodeg r
    (ring_sum(x_ring r) S
       (\s. ring_mul(x_ring r)
              (poly_const r (v s))
              (monic_vanishing_at_except r S s)))
  < 2 EXP CARD S
`,
  intro THEN
  subgoal `!s. s IN S ==> twodeg(r:R ring) (ring_mul(x_ring r) (poly_const r (v s)) (monic_vanishing_at_except r S s)) < 2 EXP CARD S` THENL [
    intro THEN
    have `poly_const r (v (s:R)) IN ring_carrier(x_ring(r:R ring))` [poly_const_in_x_ring] THEN
    have `monic_vanishing_at_except r S s IN ring_carrier(x_ring(r:R ring))` [monic_vanishing_at_except_in_x_ring] THEN
    simp[twodeg_mul] THEN
    have `twodeg(r:R ring) (poly_const r (v (s:R))) <= 1` [twodeg_poly_const;ARITH_RULE `0 <= 1`;ARITH_RULE `2 EXP 0 <= 1`] THEN
    have `twodeg r (monic_vanishing_at_except (r:R ring) S s) < 2 EXP CARD S` [twodeg_monic_vanishing_at_except_lt] THEN
    have `twodeg(r:R ring) (poly_const r (v (s:R))) * twodeg r (monic_vanishing_at_except (r:R ring) S s) <= twodeg r (monic_vanishing_at_except (r:R ring) S s)` [LE_MULT2;LE_REFL;ARITH_RULE `1 * H = H`] THEN
    qed[LET_TRANS]
  ; qed[twodeg_sum_lt]
  ]
);;

(* should factor this out of the interpolator_eval proof *)
let eval_sum_monic_vanishing_at_except = prove(`
  !(r:R ring) S v t.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  (!s. s IN S ==> v s IN ring_carrier r) ==>
  t IN S ==>
  poly_eval r t
    (ring_sum(x_ring r) S
       (\s. ring_mul(x_ring r)
              (poly_const r (v s))
              (monic_vanishing_at_except r S s)))
  = ring_mul r
      (v t)
      (poly_eval r t (monic_vanishing_at_except r S t))
`,
  intro THEN
  have `!s:R. s IN S ==> poly_const (r:R ring) (v s) IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `!s:R. s IN S ==> monic_vanishing_at_except (r:R ring) S s IN ring_carrier(x_ring r)` [monic_vanishing_at_except_in_x_ring] THEN
  have `!s:R. s IN S ==> ring_mul (x_ring r) (poly_const r (v s)) (monic_vanishing_at_except r S s) IN ring_carrier(x_ring r)` [RING_MUL] THEN
  have `poly_const (r:R ring) (v (t:R)) IN ring_carrier(x_ring r)` [] THEN
  have `monic_vanishing_at_except (r:R ring) S t IN ring_carrier(x_ring r)` [] THEN
  have `ring_mul(x_ring(r:R ring)) (poly_const r (v (t:R))) (monic_vanishing_at_except r S t) IN ring_carrier(x_ring r)` [] THEN
  have `poly_eval r t (monic_vanishing_at_except r S t) IN ring_carrier(r:R ring)` [poly_eval_in_ring] THEN
  have `ring_mul(r:R ring) (v t) (poly_eval r t (monic_vanishing_at_except r S t)) IN ring_carrier r` [RING_MUL] THEN
  specialize[`x_ring(r:R ring)`;`S:R->bool`;`\s:R. ring_mul(x_ring(r:R ring)) (poly_const r (v s)) (monic_vanishing_at_except r S s)`;`t:R`]ring_sum_delete2 THEN
  simp[] THEN
  have `ring_sum (x_ring(r:R ring)) (S DELETE t) (\s. ring_mul (x_ring r) (poly_const r (v s)) (monic_vanishing_at_except r S s)) IN ring_carrier(x_ring r)` [RING_SUM] THEN
  have `(t:R) IN ring_carrier r` [SUBSET] THEN
  have `!s:R. s IN S DELETE t ==> poly_const (r:R ring) (v s) IN ring_carrier(x_ring r)` [IN_DELETE] THEN
  have `!s:R. s IN S DELETE t ==> monic_vanishing_at_except (r:R ring) S s IN ring_carrier(x_ring r)` [IN_DELETE] THEN
  have `!s:R. s IN S DELETE t ==> ring_mul (x_ring r) (poly_const r (v s)) (monic_vanishing_at_except r S s) IN ring_carrier(x_ring r)` [IN_DELETE] THEN
  have `FINITE (S DELETE (t:R))` [FINITE_DELETE] THEN
  simp[poly_eval_add;poly_eval_mul;poly_eval_const;poly_eval_sum;o_DEF] THEN
  have `!s. s IN S DELETE t ==> poly_eval (r:R ring) t (monic_vanishing_at_except r S s) = ring_0 r` [monic_vanishing_at_except_vanishes;IN_DELETE] THEN
  simp[] THEN
  have `!s. s IN S DELETE t ==> ring_mul r (poly_eval (r:R ring) t (poly_const r (v s))) (ring_0 r) = ring_0 r` [IN_DELETE;poly_eval_in_ring;ring_mul_0] THEN
  simp[RING_SUM_EQ_0;ring_add_0]
);;

(* should factor this out of the interpolator_unique proof *)
let sum_monic_vanishing_at_except_unique = prove(`
  !(r:R ring) S p v.
  integral_domain r ==>
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  p IN ring_carrier(x_ring r) ==>
  (!s. s IN S ==> v s IN ring_carrier r) ==>
  (!s. s IN S ==>
       poly_eval r s p
       = ring_mul r
           (v s)
           (poly_eval r s
             (monic_vanishing_at_except r S s))) ==>
  twodeg r p < 2 EXP CARD S ==>
  ring_sum(x_ring r) S
    (\s. ring_mul(x_ring r)
           (poly_const r (v s))
           (monic_vanishing_at_except r S s))
  = p
`,
  intro THEN
  def `q:(num->num)->R` `ring_sum(x_ring(r:R ring)) S (\s. ring_mul(x_ring r) (poly_const r (v s)) (monic_vanishing_at_except r S s))` THEN
  have `q IN ring_carrier(x_ring(r:R ring))` [RING_SUM] THEN
  subgoal `!s:R. s IN S ==> poly_eval r s (ring_sub(x_ring r) p q) = ring_0 r` THENL [
    intro THEN
    have `poly_eval(r:R ring) s q = ring_mul r (v s) (poly_eval r s (monic_vanishing_at_except r S s))` [eval_sum_monic_vanishing_at_except] THEN
    have `poly_eval(r:R ring) s p = poly_eval r s q` [] THEN
    have `s IN ring_carrier(r:R ring)` [SUBSET] THEN
    have `poly_eval(r:R ring) s p IN ring_carrier r` [poly_eval_in_ring] THEN
    qed[poly_eval_sub;RING_SUB_REFL]
  ; pass
  ] THEN
  subgoal `twodeg r (ring_sub(x_ring(r:R ring)) p q) < 2 EXP CARD (S:R->bool)` THENL [
    have `twodeg(r:R ring) q < 2 EXP CARD (S:R->bool)` [twodeg_sum_monic_vanishing_at_except] THEN
    qed[twodeg_sub_lt]
  ; pass
  ] THEN
  have `~(2 EXP CARD(S:R->bool) <= twodeg r (ring_sub(x_ring(r:R ring)) p q))` [NOT_LE] THEN
  have `ring_sub(x_ring(r:R ring)) p q IN ring_carrier(x_ring r)` [RING_SUB] THEN
  have `ring_sub(x_ring(r:R ring)) p q = poly_0 r` [roots_le_twodeg] THEN
  qed[RING_SUB_EQ_0;x_ring_0]
);;

(* ----- vanishing_at_except_1_at *)

let vanishing_at_except_1_at = new_definition `
  vanishing_at_except_1_at (k:K ring) S s
  = poly_mul k
      (monic_vanishing_at_except k S s)
      (poly_const k
        (ring_inv k
          (poly_eval k s
            (monic_vanishing_at_except k S s))))
`;;

let vanishing_at_except_1_at_in_x_ring = prove(`
  !(k:A ring) S s.
  vanishing_at_except_1_at k S s IN ring_carrier(x_ring k)
`,
  intro THEN
  rw[vanishing_at_except_1_at] THEN
  have `poly_eval k s (monic_vanishing_at_except (k:A ring) S s) IN ring_carrier k` [poly_eval_in_ring] THEN
  have `ring_inv k (poly_eval k s (monic_vanishing_at_except (k:A ring) S s)) IN ring_carrier k` [RING_INV] THEN
  have `poly_const k (ring_inv k (poly_eval k s (monic_vanishing_at_except (k:A ring) S s))) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `monic_vanishing_at_except (k:A ring) S s IN ring_carrier(x_ring k)` [monic_vanishing_at_except_in_x_ring] THEN
  qed[x_ring_mul;RING_MUL]
);;

let twodeg_vanishing_at_except_1_at_lt = prove(`
  !(k:A ring) S s.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  s IN S ==>
  twodeg k (vanishing_at_except_1_at k S s) < 2 EXP CARD S
`,
  intro THEN
  have `integral_domain (k:A ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `twodeg (k:A ring) (monic_vanishing_at_except k S s) < 2 EXP CARD S` [twodeg_monic_vanishing_at_except_lt] THEN
  rw[vanishing_at_except_1_at] THEN
  have `poly_eval k s (monic_vanishing_at_except (k:A ring) S s) IN ring_carrier k` [poly_eval_in_ring] THEN
  have `ring_inv k (poly_eval k s (monic_vanishing_at_except (k:A ring) S s)) IN ring_carrier k` [RING_INV] THEN
  have `poly_const k (ring_inv k (poly_eval k s (monic_vanishing_at_except (k:A ring) S s))) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `monic_vanishing_at_except (k:A ring) S s IN ring_carrier(x_ring k)` [monic_vanishing_at_except_in_x_ring] THEN
  have `poly_mul (k:A ring) = ring_mul(x_ring k)` [x_ring_mul] THEN
  simp[twodeg_mul] THEN
  have `~(poly_eval (k:A ring) s (monic_vanishing_at_except k S s) = ring_0 k)` [eval_monic_vanishing_at_except_nonzero] THEN
  have `~(ring_inv k (poly_eval (k:A ring) s (monic_vanishing_at_except k S s)) = ring_0 k)` [FIELD_INV_EQ_0] THEN
  have `twodeg (k:A ring) (poly_const k (ring_inv k (poly_eval k s (monic_vanishing_at_except k S s)))) = 2 EXP 0` [twodeg_poly_const] THEN
  qed[ARITH_RULE `n * 2 EXP 0 = n`]
);;

let vanishing_at_except_1_at_vanishes = prove(`
  !(k:A ring) S t u.
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  t IN S ==>
  u IN S ==>
  ~(t = u) ==>
  poly_eval k u (vanishing_at_except_1_at k S t)
  = ring_0 k
`,
  intro THEN
  rw[vanishing_at_except_1_at] THEN
  have `(t:A) IN ring_carrier k` [SUBSET] THEN
  have `(u:A) IN ring_carrier k` [SUBSET] THEN
  have `poly_eval k t (monic_vanishing_at_except (k:A ring) S t) IN ring_carrier k` [poly_eval_in_ring] THEN
  have `ring_inv k (poly_eval k t (monic_vanishing_at_except (k:A ring) S t)) IN ring_carrier k` [RING_INV] THEN
  have `poly_const k (ring_inv k (poly_eval k t (monic_vanishing_at_except (k:A ring) S t))) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `poly_eval k u (poly_const k (ring_inv k (poly_eval k t (monic_vanishing_at_except (k:A ring) S t)))) IN ring_carrier k` [poly_eval_in_ring] THEN
  have `monic_vanishing_at_except (k:A ring) S t IN ring_carrier(x_ring k)` [monic_vanishing_at_except_in_x_ring] THEN
  have `poly_mul (k:A ring) = ring_mul(x_ring k)` [x_ring_mul] THEN
  simp[poly_eval_mul] THEN
  simp[monic_vanishing_at_except_vanishes] THEN
  simp[ring_0_mul]
);;

let vanishing_at_except_1_at_1 = prove(`
  !(k:A ring) S t.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  t IN S ==>
  poly_eval k t (vanishing_at_except_1_at k S t) = ring_1 k
`,
  intro THEN
  have `integral_domain (k:A ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `~(poly_eval (k:A ring) t (monic_vanishing_at_except k S t) = ring_0 k)` [eval_monic_vanishing_at_except_nonzero] THEN
  rw[vanishing_at_except_1_at] THEN
  have `(t:A) IN ring_carrier k` [SUBSET] THEN
  have `poly_eval k t (monic_vanishing_at_except (k:A ring) S t) IN ring_carrier k` [poly_eval_in_ring] THEN
  have `ring_inv k (poly_eval k t (monic_vanishing_at_except (k:A ring) S t)) IN ring_carrier k` [RING_INV] THEN
  have `poly_const k (ring_inv k (poly_eval k t (monic_vanishing_at_except (k:A ring) S t))) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `poly_eval k t (poly_const k (ring_inv k (poly_eval k t (monic_vanishing_at_except (k:A ring) S t)))) IN ring_carrier k` [poly_eval_in_ring] THEN
  have `monic_vanishing_at_except (k:A ring) S t IN ring_carrier(x_ring k)` [monic_vanishing_at_except_in_x_ring] THEN
  have `poly_mul (k:A ring) = ring_mul(x_ring k)` [x_ring_mul] THEN
  simp[poly_eval_mul] THEN
  simp[poly_eval_const] THEN
  simp[FIELD_MUL_RINV]
);;

(* ----- interpolator *)

let interpolator = new_definition `
  interpolator (k:K ring) S v
  = ring_sum(x_ring k) S
      (\s. ring_mul(x_ring k)
             (poly_const k (v s))
             (vanishing_at_except_1_at k S s))
`;;

let interpolator_in_x_ring = prove(`
  !(k:A ring) S v.
  interpolator k S v IN ring_carrier(x_ring k)
`,
  rw[interpolator;RING_SUM]
);;

let interpolator_empty = prove(`
  !(k:A ring) v.
  interpolator k {} v = poly_0 k
`,
  rw[interpolator;RING_SUM_CLAUSES;x_ring_0]
);;

let twodeg_interpolator_lemma = prove(`
  !(k:A ring) S v.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  s IN S ==>
  v s IN ring_carrier k ==>
  twodeg k (ring_mul(x_ring k)
             (poly_const k (v s))
             (vanishing_at_except_1_at k S s))
  < 2 EXP CARD S
`,
  intro THEN
  have `twodeg (k:A ring) (vanishing_at_except_1_at k S s) < 2 EXP CARD S` [twodeg_vanishing_at_except_1_at_lt] THEN
  have `vanishing_at_except_1_at (k:A ring) S s IN ring_carrier(x_ring k)` [vanishing_at_except_1_at_in_x_ring] THEN
  have `poly_const (k:A ring) (v (s:A)) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `integral_domain (k:A ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  simp[twodeg_mul] THEN
  have `twodeg (k:A ring) (poly_const k (v (s:A))) <= 2 EXP 0` [twodeg_poly_const_le] THEN
  qed[twopow_le_0_lt_d]
);;

let twodeg_interpolator = prove(`
  !(k:A ring) S v.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  (!s. s IN S ==> v s IN ring_carrier k) ==>
  twodeg k (interpolator k S v) < 2 EXP CARD S
`,
  intro THEN
  rw[interpolator] THEN
  qed[twodeg_interpolator_lemma;twodeg_sum_lt]
);;

let eval_interpolator = prove(`
  !(k:A ring) S v t.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  (!s. s IN S ==> v s IN ring_carrier k) ==>
  t IN S ==>
  poly_eval k t (interpolator k S v) = v t
`,
  intro THEN
  rw[interpolator] THEN
  have `!s:A. s IN S ==> poly_const (k:A ring) (v s) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
  have `!s:A. s IN S ==> vanishing_at_except_1_at (k:A ring) S s IN ring_carrier(x_ring k)` [vanishing_at_except_1_at_in_x_ring] THEN
  have `!s:A. s IN S ==> ring_mul (x_ring k) (poly_const k (v s)) (vanishing_at_except_1_at k S s) IN ring_carrier(x_ring k)` [RING_MUL] THEN
  have `poly_const (k:A ring) (v (t:A)) IN ring_carrier(x_ring k)` [] THEN
  have `vanishing_at_except_1_at (k:A ring) S t IN ring_carrier(x_ring k)` [] THEN
  have `ring_mul(x_ring(k:A ring)) (poly_const k (v (t:A))) (vanishing_at_except_1_at k S t) IN ring_carrier(x_ring k)` [] THEN
  specialize[`x_ring(k:A ring)`;`S:A->bool`;`\s:A. ring_mul(x_ring(k:A ring)) (poly_const k (v s)) (vanishing_at_except_1_at k S s)`;`t:A`]ring_sum_delete2 THEN
  simp[] THEN
  have `ring_sum (x_ring(k:A ring)) (S DELETE t) (\s. ring_mul (x_ring k) (poly_const k (v s)) (vanishing_at_except_1_at k S s)) IN ring_carrier(x_ring k)` [RING_SUM] THEN
  have `(t:A) IN ring_carrier k` [SUBSET] THEN
  have `!s:A. s IN S DELETE t ==> poly_const (k:A ring) (v s) IN ring_carrier(x_ring k)` [IN_DELETE] THEN
  have `!s:A. s IN S DELETE t ==> vanishing_at_except_1_at (k:A ring) S s IN ring_carrier(x_ring k)` [IN_DELETE] THEN
  have `!s:A. s IN S DELETE t ==> ring_mul (x_ring k) (poly_const k (v s)) (vanishing_at_except_1_at k S s) IN ring_carrier(x_ring k)` [IN_DELETE] THEN
  have `FINITE (S DELETE (t:A))` [FINITE_DELETE] THEN
  simp[poly_eval_add;poly_eval_mul;poly_eval_const;poly_eval_sum;vanishing_at_except_1_at_1;ring_mul_1;o_DEF] THEN
  have `!s. s IN S DELETE t ==> poly_eval (k:A ring) t (vanishing_at_except_1_at k S s) = ring_0 k` [vanishing_at_except_1_at_vanishes;IN_DELETE] THEN
  have `!s. s IN S DELETE t ==> ring_mul k (poly_eval (k:A ring) t (poly_const k (v s))) (ring_0 k) = ring_0 k` [IN_DELETE;poly_eval_in_ring;ring_mul_0] THEN
  simp[RING_SUM_EQ_0;ring_add_0]
);;

let interpolator_unique = prove(`
  !(k:A ring) S v p.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  (!s. s IN S ==> v s IN ring_carrier k) ==>
  p IN ring_carrier(x_ring k) ==>
  twodeg k p < 2 EXP CARD S ==>
  (!t. t IN S ==> poly_eval k t p = v t) ==>
  p = interpolator k S v
`,
  intro THEN
  have `interpolator k S v IN ring_carrier(x_ring(k:A ring))` [interpolator_in_x_ring] THEN
  handlecase `ring_sub(x_ring(k:A ring)) p (interpolator k S v) = poly_0 k` (
    qed[RING_SUB_EQ_0;x_ring_0]
  ) THEN
  have `!t:A. t IN S ==> t IN ring_carrier k` [SUBSET] THEN
  have `!t:A. t IN S ==> poly_eval k t (interpolator k S v) = v t` [eval_interpolator] THEN
  have `!t:A. t IN S ==> poly_eval k t (ring_sub(x_ring k) p (interpolator k S v)) = ring_sub k (poly_eval k t p) (poly_eval k t (interpolator k S v))` [poly_eval_sub] THEN
  have `!t:A. t IN S ==> poly_eval k t (ring_sub(x_ring k) p (interpolator k S v)) = ring_0 k` [RING_SUB_REFL] THEN
  have `integral_domain (k:A ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `ring_sub(x_ring(k:A ring)) p (interpolator k S v) IN ring_carrier(x_ring k)` [RING_SUB] THEN
  have `2 EXP CARD (S:A->bool) <= twodeg(k:A ring) (ring_sub(x_ring k) p (interpolator k S v))` [roots_le_twodeg] THEN
  have `twodeg(k:A ring) (interpolator k S v) < 2 EXP CARD (S:A->bool)` [twodeg_interpolator] THEN
  have `twodeg(k:A ring) (ring_sub(x_ring k) p (interpolator k S v)) < 2 EXP CARD (S:A->bool)` [twodeg_sub_lt] THEN
  qed[ARITH_RULE `x < y:num ==> ~(y <= x)`]
);;

(* ----- linear dependence *)

(* Multivariate/vectors.ml has the real case *)

(* the following proof is algorithmic: standard row reduction *)

let linear_dependence_waterfall = prove(`
  !k:A ring.
  integral_domain k ==>
  !V:X->bool.
  FINITE V ==>
  !W:Y->bool.
  FINITE W ==>
  CARD W < CARD V ==>
  !M:X->Y->A.
  (!(v:X) (w:Y). v IN V ==> w IN W ==> M v w IN ring_carrier k) ==>
  ?c:X->A.
    (~(!v. v IN V ==> c v = ring_0 k) /\
     (!v. v IN V ==> c v IN ring_carrier k) /\
     !w:Y. w IN W ==>
       ring_sum k V (\v. ring_mul k (c v) (M v w)) = ring_0 k)
`,
  intro_genonly THEN
  DISCH_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    have `CARD (W:Y->bool) < 0` [CARD_EQ_0;FINITE_EMPTY] THEN
    qed[ARITH_RULE `~(c < 0)`];
    pass
  ] THEN
  handlecase `!w:Y. w IN W ==> M (x:X) w = ring_0(k:A ring)` (
    EXISTS_TAC `\v:X. if v = x then ring_1(k:A ring) else ring_0 k` THEN
    conjunction [
      have `(x:X) IN x INSERT V` [IN_INSERT] THEN
      qed[integral_domain];
      pass
    ] THEN
    conjunction [
      qed[RING_1;RING_0];
      pass
    ] THEN
    intro THEN
    have `!(v:X) (w:Y). v IN V ==> v IN x INSERT V` [IN_INSERT] THEN
    have `(x:X) IN x INSERT V` [IN_INSERT] THEN
    have `!(v:X) (w:Y). v IN V ==> w IN W ==> ring_mul(k:A ring) (ring_1 k) (M (v:X) (w:Y)) = M v w` [ring_1_mul] THEN
    have `ring_mul(k:A ring) (ring_1 k) (ring_0 k) = ring_0 k` [ring_1_mul] THEN
    simp[RING_SUM_CLAUSES;RING_0] THEN
    have `!v:X. v IN V ==> ring_mul(k:A ring) (if v = x then ring_1 k else ring_0 k) (M v (w:Y)) = ring_0 k` [ring_0_mul] THEN
    specialize[`k:A ring`;`\v:X. ring_mul(k:A ring) (if v = x then ring_1 k else ring_0 k) (M v (w:Y))`;`\v:X. ring_0(k:A ring)`;`V:X->bool`]RING_SUM_EQ THEN
    simp[RING_SUM_EQ_0] THEN
    qed[RING_ADD_LZERO;RING_0]
  ) THEN
  choose `y:Y` `y IN W /\ ~(M (x:X) (y:Y) = ring_0(k:A ring))` [] THEN
  have `W = (y:Y) INSERT (W DELETE y)` [INSERT_DELETE] THEN
  have `FINITE(W DELETE (y:Y))` [FINITE_DELETE] THEN
  have `~((y:Y) IN W DELETE y)` [IN_DELETE] THEN
  have `CARD W = CARD(W DELETE (y:Y)) + 1` [CARD_CLAUSES;ADD1] THEN
  have `CARD ((x:X) INSERT V) = CARD V + 1` [CARD_CLAUSES;ADD1] THEN
  have `CARD(W DELETE (y:Y)) < CARD(V:X->bool)` [ARITH_RULE `a + 1 < b + 1 ==> a < b`] THEN
  def `L:X->Y->A` `\v:X. \w:Y. ring_sub (k:A ring) (ring_mul k (M x y) (M v w)) (ring_mul k (M v y) (M x w))` THEN
  have `(x:X) IN x INSERT V` [IN_INSERT] THEN
  have `!(v:X). v IN V ==> v IN x INSERT V` [IN_INSERT] THEN
  have `!(w:Y). w IN (W DELETE y) ==> w IN W` [IN_DELETE] THEN
  have `!v:X. !w:Y. v IN V ==> w IN (W DELETE y) ==> ring_mul k ((M:X->Y->A) v y) (M x w) IN ring_carrier(k:A ring)` [RING_MUL;RING_SUB] THEN
  have `!v:X. !w:Y. v IN V ==> w IN (W DELETE y) ==> ring_mul k ((M:X->Y->A) x y) (M v w) IN ring_carrier(k:A ring)` [RING_MUL;RING_SUB] THEN
  have `!v:X. !w:Y. v IN V ==> w IN (W DELETE y) ==> ring_sub k (ring_mul k (M x y) (M v w)) (ring_mul k ((M:X->Y->A) v y) (M x w)) IN ring_carrier(k:A ring)` [RING_SUB] THEN
  have `!v:X. !w:Y. v IN V ==> w IN (W DELETE y) ==> L v w IN ring_carrier(k:A ring)` [] THEN
  ASSUME_TAC(UNDISCH(SPEC `L:X->Y->A`(UNDISCH_ALL(SPEC `W DELETE (y:Y)`(ASSUME `!W. FINITE W ==> CARD W < CARD V ==> (!L. (!(v:X) (w:Y). v IN V ==> w IN W ==> L v w IN ring_carrier(k:A ring)) ==> (?b. ~(!v. v IN V ==> b v = ring_0 k) /\ (!v. v IN V ==> b v IN ring_carrier k) /\ (!w. w IN W ==> ring_sum k V (\v. ring_mul k (b v) (L v w)) = ring_0 k)))`))))) THEN
  choose `b:X->A` `~(!v:X. v IN V ==> b v = ring_0(k:A ring)) /\ (!v. v IN V ==> b v IN ring_carrier k) /\ !w:Y. w IN (W DELETE y) ==> ring_sum k V (\v. ring_mul k (b v) (L v w)) = ring_0 k` [] THEN
  def `c:X->A` `\v:X. if v = x then ring_neg(k:A ring) (ring_sum k V (\v:X. ring_mul k (b v) (M v (y:Y)))) else ring_mul k (b v) (M x y)` THEN
  EXISTS_TAC `c:X->A` THEN
  conjunction [
    choose `v:X` `(v:X) IN V /\ ~((b:X->A) v = ring_0 k)` [] THEN
    rw[NOT_FORALL_THM] THEN
    EXISTS_TAC `v:X` THEN
    have `(c:X->A) v = ring_mul k (b v) ((M:X->Y->A) x y)` [] THEN
    have `~((b:X->A) v = ring_0 k)` [] THEN
    have `~((M:X->Y->A) x y = ring_0 k)` [] THEN
    have `~((c:X->A) v = ring_0 k)` [integral_domain] THEN
    qed[]
  ; pass
  ] THEN
  conjunction [
    intro THEN
    handlecase `(v:X) = x` (
      qed[RING_SUM;RING_NEG]
    ) THEN
    have `(v:X) IN V` [IN_INSERT] THEN
    have `(b:X->A) v IN ring_carrier k` [] THEN
    qed[RING_MUL]
  ; pass
  ] THEN
  intro THEN
  have `ring_neg k (ring_sum k V (\v:X. ring_mul k (b v) (M v (y:Y)))) IN ring_carrier(k:A ring)` [RING_MUL;RING_NEG;RING_SUM] THEN
  have `(c:X->A) x IN ring_carrier(k:A ring)` [] THEN
  have `ring_mul k (c x) ((M:X->Y->A) x w) IN ring_carrier(k:A ring)` [RING_MUL] THEN
  specialize[`k:A ring`;`x:X`;`\v. ring_mul k (c v) ((M:X->Y->A) v w)`;`V:X->bool`](CONJUNCT2 RING_SUM_CLAUSES) THEN
  have `ring_sum k (x INSERT V) (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_add k (ring_mul k (c x) (M x w)) (ring_sum k V (\v. ring_mul k (c v) (M v w)))` [] THEN
  have `!v:X. v IN V ==> ring_mul k (c v) ((M:X->Y->A) v w) = ring_mul k (ring_mul k (b v) (M x y)) (M v w)` [] THEN
  have `!v:X. v IN V ==> ring_mul k (c v) ((M:X->Y->A) v w) = ring_mul k (b v) (ring_mul k (M x y) (M v w))` [RING_RULE `ring_mul (k:A ring) (ring_mul k b x) v = ring_mul k b (ring_mul k x v)`] THEN
  have `ring_sum k V (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M x y) (M v w)))` [RING_SUM_EQ] THEN
  have `ring_sum k (x INSERT V) (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_add k (ring_mul k (c x) (M x w)) (ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M x y) (M v w))))` [] THEN
  have `ring_mul k (ring_neg k (ring_sum k V (\v. ring_mul k (b v) (M v y)))) ((M:X->Y->A) x w) = ring_neg k (ring_mul k (ring_sum k V (\v. ring_mul k (b v) (M v (y:Y)))) (M x w))` [RING_RULE `ring_mul (k:A ring) (ring_neg k s) m = ring_neg k (ring_mul k s m)`;RING_SUM] THEN
  have `ring_mul k (c x) ((M:X->Y->A) x w) = ring_neg k (ring_mul k (ring_sum k V (\v. ring_mul k (b v) (M v (y:Y)))) (M x w))` [] THEN
  have `!v. v IN V ==> ring_mul k (b v) ((M:X->Y->A) v y) IN ring_carrier(k:A ring)` [RING_MUL] THEN
  specialize_raw[`k:A ring`;`\v. ring_mul k (b v) ((M:X->Y->A) v y)`;`(M:X->Y->A) x w`;`V:X->bool`]RING_SUM_RMUL THEN
  have `ring_mul k (ring_sum k V (\v. ring_mul k (b v) ((M:X->Y->A) v y))) (M x w) = ring_sum k V (\v. ring_mul k (ring_mul k (b v) (M v (y:Y))) (M x w))` [] THEN
  have `ring_mul k (c x) ((M:X->Y->A) x w) = ring_neg k (ring_sum k V (\v. ring_mul k (ring_mul k (b v) (M v (y:Y))) (M x w)))` [] THEN
  have `!v. v IN V ==> ring_mul k (ring_mul k (b v) ((M:X->Y->A) v y)) (M x w) = ring_mul k (b v) (ring_mul k (M v y) (M x w))` [RING_RULE `ring_mul (k:A ring) (ring_mul k b v) x = ring_mul k b (ring_mul k v x)`] THEN
  specialize[`k:A ring`;`\v. ring_mul k (ring_mul k (b v) ((M:X->Y->A) v y)) (M x w)`;`\v. ring_mul k (b v) (ring_mul k ((M:X->Y->A) v y) (M x w))`;`V:X->bool`]RING_SUM_EQ THEN
  have `ring_mul k (c x) ((M:X->Y->A) x w) = ring_neg k (ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M v y) (M x w))))` [] THEN
  have `ring_sum k (x INSERT V) (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_add k (ring_neg k (ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M v y) (M x w))))) (ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M x y) (M v w))))` [] THEN
  have `ring_sum k (x INSERT V) (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_sub k (ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M x y) (M v w)))) (ring_sum k V (\v. ring_mul k (b v) (ring_mul k (M v y) (M x w))))` [RING_RULE `ring_add (k:A ring) (ring_neg k x) y = ring_sub k y x`;RING_SUM] THEN
  have `!v. v IN V ==> ring_mul k ((M:X->Y->A) v y) (M x w) IN ring_carrier k` [RING_MUL] THEN
  have `!v. v IN V ==> ring_mul k ((M:X->Y->A) x y) (M v w) IN ring_carrier k` [RING_MUL] THEN
  have `!v. v IN V ==> ring_mul k (b v) (ring_mul k ((M:X->Y->A) v y) (M x w)) IN ring_carrier k` [RING_MUL] THEN
  have `!v. v IN V ==> ring_mul k (b v) (ring_mul k ((M:X->Y->A) x y) (M v w)) IN ring_carrier k` [RING_MUL] THEN
  specialize[`k:A ring`;`\v. ring_mul k (b v) (ring_mul k ((M:X->Y->A) x y) (M v w))`;`\v. ring_mul k (b v) (ring_mul k ((M:X->Y->A) v y) (M x w))`;`V:X->bool`](GSYM ring_sum_sub) THEN
  have `ring_sum k (x INSERT V) (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_sum k V (\v. ring_sub k (ring_mul k (b v) (ring_mul k (M x y) (M v w))) (ring_mul k (b v) (ring_mul k (M v y) (M x w))))` [] THEN
  ASSUME_TAC(GEN `v:X` (ISPECL[`k:A ring`;`(b:X->A) v`;`ring_mul k ((M:X->Y->A) x y) (M v w)`;`ring_mul k ((M:X->Y->A) v y) (M x w)`]RING_SUB_LDISTRIB)) THEN
  have `!v. v IN V ==> ring_sub k (ring_mul k (b v) (ring_mul k ((M:X->Y->A) x y) (M v w))) (ring_mul k (b v) (ring_mul k (M v y) (M x w))) = ring_mul k (b v) (ring_sub k (ring_mul k ((M:X->Y->A) x y) (M v w)) (ring_mul k (M v y) (M x w)))` [] THEN
  have `!v. v IN V ==> ring_sub k (ring_mul k (b v) (ring_mul k ((M:X->Y->A) x y) (M v w))) (ring_mul k (b v) (ring_mul k (M v y) (M x w))) = ring_mul k (b v) (L v w)` [] THEN
  have `ring_sum k V (\v. ring_sub k (ring_mul k (b v) (ring_mul k ((M:X->Y->A) x y) (M v w))) (ring_mul k (b v) (ring_mul k (M v y) (M x w)))) = ring_sum k V (\v. ring_mul k (b v) (L v w))` [RING_SUM_EQ] THEN
  have `ring_sum k (x INSERT V) (\v. ring_mul k (c v) ((M:X->Y->A) v w)) = ring_sum k V (\v. ring_mul k (b v) (L v w))` [] THEN
  handlecase `w = (y:Y)` (
    have `!v. v IN V ==> ring_sub k (ring_mul k ((M:X->Y->A) x y) (M v y)) (ring_mul k (M v y) (M x y)) = ring_0 k` [RING_RULE `ring_sub(k:A ring) (ring_mul k x v) (ring_mul k v x) = ring_0 k`] THEN
    have `!v. v IN V ==> (L:X->Y->A) v y = ring_0 k` [] THEN
    have `!v. v IN V ==> ring_mul k (b v) ((L:X->Y->A) v y) = ring_0 k` [ring_mul_0] THEN
    have `ring_sum k V (\v. ring_mul k (b v) ((L:X->Y->A) v w)) = ring_0 k` [RING_SUM_EQ_0] THEN
    qed[]
  ) THEN
  have `w IN W DELETE (y:Y)` [IN_DELETE] THEN
  qed[]
);;

let linear_dependence = prove(`
  !(k:A ring) (V:X->bool) (W:Y->bool) (M:X->Y->A).
  integral_domain k ==>
  FINITE V ==>
  FINITE W ==>
  CARD W < CARD V ==>
  (!(v:X) (w:Y). v IN V ==> w IN W ==> M v w IN ring_carrier k) ==>
  ?c:X->A.
    (~(!v. v IN V ==> c v = ring_0 k) /\
     (!v. v IN V ==> c v IN ring_carrier k) /\
     !w:Y. w IN W ==>
       ring_sum k V (\v. ring_mul k (c v) (M v w)) = ring_0 k)
`,
  simp[linear_dependence_waterfall]
);;

(* ----- zcoeff *)

let zcoeff = new_definition `
  zcoeff (r:R ring) (d:int) (p:(num->num)->R)
  = if d < &0 then ring_0 r else coeff (num_of_int d) p
`;;

let zcoeff_in_ring = prove(`
  !(r:R ring) d p.
  p IN ring_carrier(x_ring r) ==>
  zcoeff r d p IN ring_carrier r
`,
  rw[zcoeff] THEN
  qed[RING_0;coeff_in_ring]
);;

let zcoeff_add = prove(`
  !(r:R ring) d p q.
  zcoeff r d (ring_add(x_ring r) p q)
  = ring_add r (zcoeff r d p) (zcoeff r d q)
`,
  rw[zcoeff] THEN
  qed[coeff_add;RING_0;RING_ADD_LZERO]
);;

let zcoeff_expand = prove(`
  !(k:K ring) p q t c e.
  q IN ring_carrier(x_ring k) ==>
  (!d:num. d < t ==> c d IN ring_carrier k) ==>
  p = ring_sum(x_ring k) {d:num | d < t} (\d. const_x_pow k (c d) d) ==>
  coeff e (ring_mul(x_ring k) p q)
  = ring_sum k {d:num | d < t} (\d. ring_mul k (c d) (zcoeff k (&e - &d) q))
`,
  intro THEN
  have `FINITE {d:num | d < t}` [FINITE_NUMSEG_LT] THEN
  set_tac `!d:num. d IN {d:num | d < t} ==> d < t` [] THEN
  have `!d:num. d IN {d:num | d < t} ==> const_x_pow k (c d) d IN ring_carrier(x_ring(k:K ring))` [const_x_pow_in_x_ring] THEN
  simp[ISPECL[`x_ring(k:K ring)`;`\d:num. const_x_pow(k:K ring) (c d) d`;`b:(num->num)->K`;`{d:num | d < t}`](GSYM RING_SUM_RMUL)] THEN
  have `!d:num. d IN {d:num | d < t} ==> ring_mul(x_ring k) (const_x_pow k (c d) d) q IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  simp[ISPECL[`k:K ring`;`e:num`;`\d:num. ring_mul(x_ring(k:K ring)) (const_x_pow k (c d) d) q`;`{d:num | d < t}`]coeff_sum] THEN
  simp[coeff_mul_poly_oneindex;x_ring_mul;coeff_const_x_pow] THEN
  rw[COND_RAND;COND_RATOR] THEN
  have `!d:num. coeff d q IN ring_carrier(k:K ring)` [coeff_in_ring] THEN
  have `!a:num d:num. a < t ==> ring_mul(k:K ring) (c a) (coeff d q) IN ring_carrier(k:K ring)` [RING_MUL] THEN
  have `!d:num. ring_mul(k:K ring) (ring_0 k) (coeff d q) = ring_0 k` [ring_0_mul] THEN
  have `!d:num. d < t ==> ring_mul(k:K ring) (c d) (ring_0 k) = ring_0 k` [ring_mul_0] THEN
  simp[RING_SUM_DELTA;RING_SUM_EQ] THEN
  rw[zcoeff;COND_RAND] THEN
  havetac `!a. ~(&e - &a < &0:int) ==> num_of_int (&e - &a) = e - a` (
    intro THEN
    int_linear `~(&e - &a < &0:int) ==> &a <= &e:int` THEN
    have `a:num <= e` [INT_OF_NUM_LE] THEN
    choose `x:num` `e = a + x:num` [LE_EXISTS] THEN
    have `&e:int = &a + &x` [INT_OF_NUM_ADD] THEN
    int_linear `&e:int = &a + &x ==> &e - &a = &x:int` THEN
    have `num_of_int (&e - &a) = x` [NUM_OF_INT_OF_NUM] THEN
    qed[ADD_SUB2]
  ) THEN
  simp[] THEN
  havetac `!a. &e - &a < &0:int <=> ~(a <= e)` (
    intro THEN
    forwardreverse [
      intro THEN
      int_linear `&e - &a < &0:int ==> ~(&a <= &e:int)`
    ;
      intro THEN
      int_linear `~(&e - &a < &0:int) ==> &a <= &e:int`
    ] THEN
    qed[INT_OF_NUM_LE]
  ) THEN
  simp[COND_SWAP] THEN
  set_tac `!a:num. a IN {a | a <= e} <=> a <= e` [] THEN
  simp[]
);;

(* ----- approximant lemmas *)

let approximant_exists_lemma_aBbA1 = prove(`
  !(k:K ring) A B t c a b aBbA e.
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  (!d:num. d < t+(t+1) ==> c d IN ring_carrier k) ==>
  a = ring_sum(x_ring k) {d:num | d < t+1} (\d. const_x_pow k (c (t+d)) d) ==>
  b = ring_sum(x_ring k) {d:num | d < t} (\d. const_x_pow k (c d) d) ==>
  aBbA = ring_add(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) ==>
  coeff e aBbA = ring_add k
    (ring_sum k {d:num | d < t+1} (\d. ring_mul k (c (t+d)) (zcoeff k (&e - &d) B)))
    (ring_sum k {d:num | d < t} (\d. ring_mul k (c d) (zcoeff k (&e - &d) A)))
`,
  intro THEN
  num_linear `!d:num. d < t+1 ==> t+d < t+(t+1)` THEN
  have `!d:num. d < t+1 ==> c (t+d) IN ring_carrier(k:K ring)` [] THEN
  specialize[`k:K ring`;`a:(num->num)->K`;`B:(num->num)->K`;`t+1`;`\d. (c:num->K) (t+d)`;`e:num`]zcoeff_expand THEN
  num_linear `!d:num. d < t ==> d < t+(t+1)` THEN
  have `!d:num. d < t ==> c d IN ring_carrier(k:K ring)` [] THEN
  specialize[`k:K ring`;`b:(num->num)->K`;`A:(num->num)->K`;`t:num`;`c:num->K`;`e:num`]zcoeff_expand THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `b IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `coeff e aBbA = ring_add(k:K ring) (coeff e (ring_mul(x_ring k) a B)) (coeff e (ring_mul(x_ring k) b A))` [coeff_add] THEN
  qed[]
);;

let approximant_exists_lemma_aBbA2 = prove(`
  !(k:K ring) A B M n t c a b aBbA e etn.
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  M = (\i:num. \d:num. if i < t then zcoeff k (&d + &n - &t - &i) A else zcoeff k (&d + &n - &i) B) ==>
  (!d:num. d < t+(t+1) ==> c d IN ring_carrier k) ==>
  a = ring_sum(x_ring k) {d:num | d < t+1} (\d. const_x_pow k (c (t+d)) d) ==>
  b = ring_sum(x_ring k) {d:num | d < t} (\d. const_x_pow k (c d) d) ==>
  aBbA = ring_add(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) ==>
  etn + n = e + t ==>
  coeff e aBbA = ring_sum k {i:num | i < t+(t+1)} (\i. ring_mul k (c i) (M i etn))
`,
  intro THEN
  have `FINITE {i | i < t+(t+1)}` [FINITE_NUMSEG_LT] THEN
  have `{i | i < t+(t+1)} = {i | t <= i /\ i < t+(t+1)} UNION {i | i < t}` [lt_double1_as_disjoint_union_lt] THEN
  have `DISJOINT {i | t <= i /\ i < t+(t+1)} {i | i < t}` [lt_double1_as_disjoint_union_lt] THEN
  have `FINITE {i:num | i < t}` [FINITE_NUMSEG_LT] THEN
  have `FINITE {i | t <= i /\ i < t+(t+1)}` [FINITE_UNION] THEN
  rw[UNDISCH_ALL(ISPECL[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`;`c:num->K`;`a:(num->num)->K`;`b:(num->num)->K`;`aBbA:(num->num)->K`;`e:num`]approximant_exists_lemma_aBbA1)] THEN
  set_tac `!i:num. i IN {i | i < t} ==> i < t` [] THEN
  set_tac `!i:num. i IN {i | t <= i /\ i < t+(t+1)} ==> t <= i /\ i < t+(t+1)` [] THEN
  num_linear `!i:num. t <= i /\ i < t+(t+1) ==> ~(i < t)` THEN
  have `!i:num. i IN {i | t <= i /\ i < t+(t+1)} ==> ~(i < t)` [] THEN
  simp[RING_SUM_UNION] THEN
  num_linear `!d. etn + n = e + t ==> &e - &d:int = &etn + &n - &(t + d)` THEN
  num_linear `!d. &etn + &n - &(t + d):int = &etn + &n - &t - &d` THEN
  simp[ring_sum_range_shift]
);;

let approximant_exists_lemma_aBbA3 = prove(`
  !(k:K ring) A B M n t c a b aBbA e etn.
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  M = (\i:num. \d:num. if i < t then zcoeff k (&d + &n - &t - &i) A else zcoeff k (&d + &n - &i) B) ==>
  (!d:num. d < t+(t+1) ==> c d IN ring_carrier k) ==>
  (!w. w IN {i | i < t + t} ==> ring_sum k {i | i < t + t + 1} (\v. ring_mul k (c v) (M v w)) = ring_0 k) ==>
  a = ring_sum(x_ring k) {d:num | d < t+1} (\d. const_x_pow k (c (t+d)) d) ==>
  b = ring_sum(x_ring k) {d:num | d < t} (\d. const_x_pow k (c d) d) ==>
  aBbA = ring_add(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) ==>
  etn + n = e + t ==>
  etn < t + t ==>
  coeff e aBbA = ring_0 k
`,
  intro THEN
  rw[UNDISCH_ALL(ISPECL[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`M:num->num->K`;`n:num`;`t:num`;`c:num->K`;`a:(num->num)->K`;`b:(num->num)->K`;`aBbA:(num->num)->K`;`e:num`;`etn:num`]approximant_exists_lemma_aBbA2)] THEN
  set_tac `etn:num < t + t ==> etn IN {i | i < t + t}` [] THEN
  qed[]
);;

let approximant_exists_lemma_aBbA4 = prove(`
  !(k:K ring) A B M n t c a b aBbA e.
  integral_domain k ==>
  A IN ring_carrier(x_ring k) ==>
  twodeg k A = 2 EXP n ==>
  B IN ring_carrier(x_ring k) ==>
  twodeg k B < twodeg k A ==>
  M = (\i:num. \d:num. if i < t then zcoeff k (&d + &n - &t - &i) A else zcoeff k (&d + &n - &i) B) ==>
  (!d:num. d < t+(t+1) ==> c d IN ring_carrier k) ==>
  (!w. w IN {i | i < t + t} ==> ring_sum k {i | i < t + t + 1} (\v. ring_mul k (c v) (M v w)) = ring_0 k) ==>
  a = ring_sum(x_ring k) {d:num | d < t+1} (\d. const_x_pow k (c (t+d)) d) ==>
  b = ring_sum(x_ring k) {d:num | d < t} (\d. const_x_pow k (c d) d) ==>
  aBbA = ring_add(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) ==>
  n <= e + t ==>
  coeff e aBbA = ring_0 k
`,
  intro THEN
  havetac `twodeg(k:K ring) a <= 2 EXP t` (
    have `!v:num. v < t+1 ==> t+v < t+(t+1)` [ARITH_RULE `v < t+1 ==> t+v < t+(t+1)`] THEN
    set_tac `!v:num. t+v < t+(t+1) ==> t+v IN {i | i < t+(t+1)}` [] THEN
    have `!v:num. v < t+1 ==> c (t+v) IN ring_carrier(k:K ring)` [] THEN
    specialize[`k:K ring`;`\v. (c:num->K) (t+v)`;`t:num`]twodeg_sum_const_x_pow_le1 THEN
    qed[]
  ) THEN
  havetac `twodeg(k:K ring) b < 2 EXP t` (
    have `!d:num. d < t ==> d < t+(t+1)` [ARITH_RULE `d < t ==> d < t+(t+1)`] THEN
    set_tac `!d:num. d < t+(t+1) ==> d IN {i | i < t+(t+1)}` [] THEN
    have `!d:num. d < t ==> c d IN ring_carrier(k:K ring)` [] THEN
    specialize[`k:K ring`;`c:num->K`;`t:num`]twodeg_sum_const_x_pow_lt THEN
    qed[]
  )
  THEN
  handlecase `e < t+n:num` (
    choose `etn:num` `e + t = n + etn:num` [LE_EXISTS] THEN
    num_linear `e + t = n + etn:num ==> etn + n = e + t` THEN
    num_linear `e < t + n:num ==> etn + n = e + t ==> etn < t + t` THEN
    rw[UNDISCH_ALL(ISPECL[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`M:num->num->K`;`n:num`;`t:num`;`c:num->K`;`a:(num->num)->K`;`b:(num->num)->K`;`aBbA:(num->num)->K`;`e:num`;`etn:num`]approximant_exists_lemma_aBbA3)]
  )
  THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `b IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `twodeg k (ring_mul(x_ring(k:K ring)) a B) = twodeg k a * twodeg k B` [twodeg_mul] THEN
  have `twodeg (k:K ring) a * twodeg k B <= 2 EXP t * twodeg k B` [LE_MULT2;LE_REFL] THEN
  have `2 EXP t * twodeg (k:K ring) B < 2 EXP t * 2 EXP n` [LT_LMULT;twopow_nonzero] THEN
  have `twodeg (k:K ring) a * twodeg k B < 2 EXP t * 2 EXP n` [LET_TRANS] THEN
  have `twodeg k (ring_mul(x_ring(k:K ring)) b A) = twodeg k b * twodeg k A` [twodeg_mul] THEN
  have `twodeg (k:K ring) b * twodeg k A < 2 EXP t * 2 EXP n` [lt_rmult;twopow_nonzero] THEN
  have `twodeg k (ring_mul(x_ring(k:K ring)) a B) < 2 EXP t * 2 EXP n` [] THEN
  have `twodeg k (ring_mul(x_ring(k:K ring)) b A) < 2 EXP t * 2 EXP n` [] THEN
  have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  specialize[`k:K ring`;`ring_mul(x_ring(k:K ring)) a B`;`ring_mul(x_ring(k:K ring)) b A`;`2 EXP t * 2 EXP n`]twodeg_add_lt THEN
  have `aBbA IN ring_carrier(x_ring(k:K ring))` [RING_ADD] THEN
  have `twodeg (k:K ring) aBbA < 2 EXP (t+n)` [EXP_ADD] THEN
  num_linear `~(e:num < t + n) ==> t + n <= e` THEN
  have `2 EXP (t+n) <= 2 EXP e` [twopow_mono_le] THEN
  have `twodeg (k:K ring) aBbA < 2 EXP e` [LTE_TRANS] THEN
  num_linear `twodeg (k:K ring) aBbA < 2 EXP e ==> ~(2 EXP e <= twodeg k aBbA)` THEN
  qed[support_le_twodeg]
);;

let approximant_exists_lemma_aBbA5 = prove(`
  !(k:K ring) A B M n t c a b aBbA.
  integral_domain k ==>
  A IN ring_carrier(x_ring k) ==>
  twodeg k A = 2 EXP n ==>
  B IN ring_carrier(x_ring k) ==>
  twodeg k B < twodeg k A ==>
  M = (\i:num. \d:num. if i < t then zcoeff k (&d + &n - &t - &i) A else zcoeff k (&d + &n - &i) B) ==>
  (!d:num. d < t+(t+1) ==> c d IN ring_carrier k) ==>
  (!w. w IN {i | i < t + t} ==> ring_sum k {i | i < t + t + 1} (\v. ring_mul k (c v) (M v w)) = ring_0 k) ==>
  a = ring_sum(x_ring k) {d:num | d < t+1} (\d. const_x_pow k (c (t+d)) d) ==>
  b = ring_sum(x_ring k) {d:num | d < t} (\d. const_x_pow k (c d) d) ==>
  aBbA = ring_add(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) ==>
  2 EXP t * twodeg k aBbA < 2 EXP n
`,
  intro THEN
  havetac `!e. n <= e+t ==> coeff e aBbA = ring_0(k:K ring)` (
    intro THEN
    rw[UNDISCH_ALL(ISPECL[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`M:num->num->K`;`n:num`;`t:num`;`c:num->K`;`a:(num->num)->K`;`b:(num->num)->K`;`aBbA:(num->num)->K`;`e:num`]approximant_exists_lemma_aBbA4)]
  ) THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `b IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `aBbA IN ring_carrier(x_ring(k:K ring))` [RING_ADD] THEN
  qed[shift_twodeg_lt_support]
);;

let approximant_exists_lemma_kronecker = prove(`
  !(k:K ring) A B t.
  field k ==>
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  twodeg k B < twodeg k A ==>
  ?a b.
     a IN ring_carrier(x_ring k)
  /\ b IN ring_carrier(x_ring k)
  /\ ~(a = poly_0 k /\ b = poly_0 k)
  /\ twodeg k a <= 2 EXP t
  /\ twodeg k b < 2 EXP t
  /\ 2 EXP t * twodeg k (ring_add(x_ring k)
                          (ring_mul(x_ring k) a B)
                          (ring_mul(x_ring k) b A))
     < twodeg k A
`,
  intro THEN
  have `~((A:(num->num)->K) = poly_0(k:K ring))` [twodeg_0;ARITH_RULE `~(b < 0)`] THEN
  def `n:num` `maximum (x_support(k:K ring) A)` THEN
  have `twodeg(k:K ring) A = 2 EXP n` [twodeg] THEN
  specialize[`t+(t+1)`]FINITE_NUMSEG_LT THEN
  specialize[`t+(t+1)`]CARD_NUMSEG_LT THEN
  specialize[`t+t:num`]FINITE_NUMSEG_LT THEN
  specialize[`t+t:num`]CARD_NUMSEG_LT THEN
  have `CARD {i:num | i < t+t} < CARD {i | i < t+(t+1)}` [ARITH_RULE `t+t < t+(t+1)`] THEN
  def `M:num->num->K` `\i:num. \d:num. if i < t then zcoeff (k:K ring) (&d + &n - &t - &i) A else zcoeff (k:K ring) (&d + &n - &i) B` THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `!i:num. !d:num. i IN {i | i < t+(t+1)} ==> d IN {i | i < t+t} ==> (M:num->num->K) i d IN ring_carrier k` [zcoeff_in_ring] THEN
  specialize[`k:K ring`;`{i | i < t+(t+1)}`;`{i:num | i < t+t}`;`M:num->num->K`]linear_dependence THEN
  choose `c:num->K` `~(!v:num. v IN {i | i < t+(t+1)} ==> c v = ring_0(k:K ring)) /\ (!v. v IN {i | i < t+(t+1)} ==> c v IN ring_carrier k) /\ (!w:num. w IN {i | i < t+t} ==> ring_sum k {i | i < t+(t+1)} (\v. ring_mul k (c v) (M v w)) = ring_0 k)` [] THEN
  def `b:(num->num)->K` `ring_sum(x_ring(k:K ring)) {d:num | d < t} (\d. const_x_pow k (c d) d)` THEN
  def `a:(num->num)->K` `ring_sum(x_ring(k:K ring)) {d:num | d < t+1} (\d. const_x_pow k (c (t+d)) d)` THEN
  EXISTS_TAC `a:(num->num)->K` THEN
  EXISTS_TAC `b:(num->num)->K` THEN
  havetac `twodeg(k:K ring) a <= 2 EXP t` (
    have `!v:num. v < t+1 ==> t+v < t+(t+1)` [ARITH_RULE `v < t+1 ==> t+v < t+(t+1)`] THEN
    set_tac `!v:num. t+v < t+(t+1) ==> t+v IN {i | i < t+(t+1)}` [] THEN
    have `!v:num. v < t+1 ==> c (t+v) IN ring_carrier(k:K ring)` [] THEN
    specialize[`k:K ring`;`\v. (c:num->K) (t+v)`;`t:num`]twodeg_sum_const_x_pow_le1 THEN
    qed[]
  ) THEN
  havetac `twodeg(k:K ring) b < 2 EXP t` (
    have `!d:num. d < t ==> d < t+(t+1)` [ARITH_RULE `d < t ==> d < t+(t+1)`] THEN
    set_tac `!d:num. d < t+(t+1) ==> d IN {i | i < t+(t+1)}` [] THEN
    have `!d:num. d < t ==> c d IN ring_carrier(k:K ring)` [] THEN
    specialize[`k:K ring`;`c:num->K`;`t:num`]twodeg_sum_const_x_pow_lt THEN
    qed[]
  ) THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `b IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  intro THENL [
    (* a is in ring; done above *)
    qed[]
  ; (* b is in ring; done above *)
    qed[]
  ; (* a and b are not both 0 *)
    choose `d:num` `(d:num) IN {i | i < t+(t+1)} /\ ~(c d = ring_0(k:K ring))` [] THEN
    handlecase `d:num < t` (
      have `!d:num. d < t ==> d < t+(t+1)` [ARITH_RULE `d < t ==> d < t+(t+1)`] THEN
      set_tac `!d:num. d < t+(t+1) ==> d IN {i | i < t+(t+1)}` [] THEN
      have `!d:num. d < t ==> d IN {i | i < t+(t+1)}` [] THEN
      have `!d:num. d < t ==> c d IN ring_carrier(k:K ring)` [] THEN
      specialize[`k:K ring`;`d:num`;`c:num->K`;`t:num`]coeff_sum_const_x_pow THEN
      have `coeff d b = c d:K` [] THEN
      qed[coeff_0]
    ) THEN
    have `t <= d:num` [NOT_LT] THEN
    choose `v:num` `d = t + v:num` [LE_EXISTS] THEN
    set_tac `d IN {i | i < t+(t+1)} ==> d < t+(t+1)` [] THEN
    have `v < t+1` [ARITH_RULE `t+v < t+(t+1) ==> v < t+1`] THEN
    have `!v:num. v < t+1 ==> t+v < t+(t+1)` [ARITH_RULE `v < t+1 ==> t+v < t+(t+1)`] THEN
    set_tac `!v:num. t+v < t+(t+1) ==> t+v IN {i | i < t+(t+1)}` [] THEN
    have `!v:num. v < t+1 ==> t+v IN {i | i < t+(t+1)}` [] THEN
    have `!v:num. v < t+1 ==> c (t+v) IN ring_carrier(k:K ring)` [] THEN
    specialize[`k:K ring`;`v:num`;`\v. (c:num->K) (t+v)`;`t+1`]coeff_sum_const_x_pow THEN
    have `coeff v a = c (t+v):K` [] THEN
    qed[coeff_0]
  ; (* bound a degree; done above *)
    qed[]
  ; (* bound b degree; done above *)
    qed[]
  ; pass
    (* bound aB-bA degree; done below *)
  ] THEN
  def `aBbA:(num->num)->K` `ring_add (x_ring(k:K ring)) (ring_mul (x_ring k) a B) (ring_mul (x_ring k) b A)` THEN
  have `!d:num. d < t ==> d < t+(t+1)` [ARITH_RULE `d < t ==> d < t+(t+1)`] THEN
  set_tac `!d:num. d < t+(t+1) ==> d IN {i | i < t+(t+1)}` [] THEN
  have `!d:num. d < t ==> d IN {i | i < t+(t+1)}` [] THEN
  have `!d. d < t+(t+1) ==> c d IN ring_carrier(k:K ring)` [] THEN
  have `!w:num. w IN {i | i < t+t} ==> ring_sum k {i | i < t+(t+1)} (\v. ring_mul k (c v) ((M:num->num->K) v w)) = ring_0(k:K ring)` [] THEN
  specialize[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`M:num->num->K`;`n:num`;`t:num`;`c:num->K`;`a:(num->num)->K`;`b:(num->num)->K`;`aBbA:(num->num)->K`]approximant_exists_lemma_aBbA5 THEN
  qed[]
);;

let approximant_exists_lemma_kronecker_neg = prove(`
  !(k:K ring) A B t.
  field k ==>
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  twodeg k B < twodeg k A ==>
  ?a b.
     a IN ring_carrier(x_ring k)
  /\ b IN ring_carrier(x_ring k)
  /\ ~(a = poly_0 k /\ b = poly_0 k)
  /\ twodeg k a <= 2 EXP t
  /\ twodeg k b < 2 EXP t
  /\ 2 EXP t * twodeg k (ring_sub(x_ring k)
                          (ring_mul(x_ring k) a B)
                          (ring_mul(x_ring k) b A))
     < twodeg k A
`,
  intro THEN
  choose_specializing `a:(num->num)->K`[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`]approximant_exists_lemma_kronecker THEN
  choose `bneg:(num->num)->K` `a IN ring_carrier (x_ring(k:K ring)) /\ bneg IN ring_carrier (x_ring k) /\ ~(a = poly_0 k /\ bneg = poly_0 k) /\ twodeg k a <= 2 EXP t /\ twodeg k bneg < 2 EXP t /\ 2 EXP t * twodeg k (ring_add (x_ring k) (ring_mul (x_ring k) a B) (ring_mul (x_ring k) bneg A)) < twodeg k A` [] THEN
  def `b:(num->num)->K` `ring_neg(x_ring(k:K ring)) bneg` THEN
  EXISTS_TAC `a:(num->num)->K` THEN
  EXISTS_TAC `b:(num->num)->K` THEN
  intro THENL [
    (* a in ring *)
    qed[]
  ; (* b in ring *)
    qed[RING_NEG]
  ; (* a and b not both 0 *)
    have `b = ring_0(x_ring(k:K ring))` [x_ring_0] THEN
    have `ring_neg(x_ring k) b = ring_0(x_ring(k:K ring))` [RING_NEG_0] THEN
    have `bneg = ring_0(x_ring(k:K ring))` [RING_NEG_NEG] THEN
    have `bneg:(num->num)->K = poly_0(k:K ring)` [x_ring_0] THEN
    qed[]
  ; (* a degree <= t *)
    qed[]
  ; (* b degree < t *)
    qed[twodeg_neg]
  ; (* aBbA *)
    have `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) = ring_add(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) bneg A)` [RING_RULE `ring_sub(r:R ring) (ring_mul r a B) (ring_mul r (ring_neg r bneg) A) = ring_add r (ring_mul r a B) (ring_mul r bneg A)`] THEN
    qed[]
  ]
);;

(* ----- approximants *)

let approximant = new_definition `
  approximant (k:K ring) A B t a b
  <=> A IN ring_carrier(x_ring k)
   /\ B IN ring_carrier(x_ring k)
   /\ a IN ring_carrier(x_ring k)
   /\ b IN ring_carrier(x_ring k)
   /\ ring_coprime(x_ring k) (a,b)
   /\ twodeg k a <= 2 EXP t
   /\ 2 EXP t * twodeg k (ring_sub(x_ring k)
                           (ring_mul(x_ring k) a B)
                           (ring_mul(x_ring k) b A))
      < twodeg k A
`;;

let small_approximant = new_definition `
  small_approximant (k:K ring) A B t a b
  <=> approximant k A B t a b
   /\ twodeg k b < 2 EXP t
`;;

let small_approximant_exists = prove(`
  !(k:K ring) A B t.
  field k ==>
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  twodeg k B < twodeg k A ==>
  ?a b. small_approximant k A B t a b
`,
  intro THEN
  rw[small_approximant;approximant] THEN
  choose_specializing `a:(num->num)->K` [`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`]approximant_exists_lemma_kronecker_neg THEN
  choose `b:(num->num)->K` `a IN ring_carrier(x_ring(k:K ring)) /\ b IN ring_carrier(x_ring k) /\ ~(a = poly_0 k /\ b = poly_0 k) /\ twodeg k a <= 2 EXP t /\ twodeg k b < 2 EXP t /\ 2 EXP t * twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A)) < twodeg k A` [] THEN
  specialize_raw[`k:K ring`;`a:(num->num)->K`;`b:(num->num)->K`]x_ring_lowest_terms THEN
  choose `ag:(num->num)->K` `?bg. ag IN ring_carrier(x_ring k) /\ bg IN ring_carrier(x_ring k) /\ a = ring_mul(x_ring(k:K ring)) (ring_gcd(x_ring k) (a,b)) ag /\ b = ring_mul(x_ring k) (ring_gcd(x_ring k) (a,b)) bg /\ ring_coprime(x_ring k) (ag,bg)` [] THEN
  choose `bg:(num->num)->K` `ag IN ring_carrier(x_ring k) /\ bg IN ring_carrier(x_ring k) /\ a = ring_mul(x_ring(k:K ring)) (ring_gcd(x_ring k) (a,b)) ag /\ b = ring_mul(x_ring k) (ring_gcd(x_ring k) (a,b)) bg /\ ring_coprime(x_ring k) (ag,bg)` [] THEN
  EXISTS_TAC `ag:(num->num)->K` THEN
  EXISTS_TAC `bg:(num->num)->K` THEN
  def `g:(num->num)->K` `ring_gcd(x_ring(k:K ring)) (a,b)` THEN
  have `g IN ring_carrier(x_ring(k:K ring))` [RING_GCD] THEN
  have `~(g:(num->num)->K = poly_0 k)` [x_ring_gcd_nonzero] THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `twodeg(k:K ring) ag <= twodeg k a` [twodeg_mul_ge] THEN
  have `twodeg(k:K ring) ag <= 2 EXP t` [LE_TRANS] THEN
  have `twodeg(k:K ring) bg <= twodeg k b` [twodeg_mul_ge] THEN
  have `twodeg(k:K ring) bg < 2 EXP t` [LET_TRANS] THEN
  have `ring_mul(x_ring k) ag B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) bg A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_sub(x_ring k) (ring_mul(x_ring k) ag B) (ring_mul(x_ring k) bg A) IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring(k:K ring)) g (ring_sub(x_ring k) (ring_mul(x_ring k) ag B) (ring_mul(x_ring k) bg A)) = ring_sub(x_ring k) (ring_mul(x_ring k) (ring_mul(x_ring k) g ag) B) (ring_mul(x_ring k) (ring_mul(x_ring k) g bg) A)` [RING_RULE `ring_mul(r:R ring) g (ring_sub r (ring_mul r ag u) (ring_mul r bg v)) = ring_sub r (ring_mul r (ring_mul r g ag) u) (ring_mul r (ring_mul r g bg) v)`] THEN
  have `ring_mul(x_ring(k:K ring)) g (ring_sub(x_ring k) (ring_mul(x_ring k) ag B) (ring_mul(x_ring k) bg A)) = ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A)` [] THEN
  have `twodeg(k:K ring) (ring_sub(x_ring k) (ring_mul(x_ring k) ag B) (ring_mul(x_ring k) bg A)) <= twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))` [twodeg_mul_ge] THEN
  have `2 EXP t * twodeg(k:K ring) (ring_sub(x_ring k) (ring_mul(x_ring k) ag B) (ring_mul(x_ring k) bg A)) <= 2 EXP t * twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))` [LE_MULT2;LE_REFL] THEN
  have `2 EXP t * twodeg(k:K ring) (ring_sub(x_ring k) (ring_mul(x_ring k) ag B) (ring_mul(x_ring k) bg A)) < twodeg k A` [LET_TRANS] THEN
  qed[]
);;

let approximant_best = prove(`
  !(k:K ring) A B t a b c d.
  field k ==>
  approximant k A B t a b ==>
  c IN ring_carrier(x_ring k) ==>
  d IN ring_carrier(x_ring k) ==>
  twodeg k c <= 2 EXP t ==>
  2 EXP t * twodeg k (ring_sub(x_ring k)
                       (ring_mul(x_ring k) c B)
                       (ring_mul(x_ring k) d A))
  < twodeg k A ==>
  ?L.
     L IN ring_carrier(x_ring k)
  /\ c = ring_mul(x_ring k) a L
  /\ d = ring_mul(x_ring k) b L
`,
  rw[approximant] THEN
  intro THEN
  have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) c B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) d A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A) IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A) IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring k) c (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A)) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) a (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A)) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) a d IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b c IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_sub(x_ring k) (ring_mul(x_ring k) a d) (ring_mul(x_ring k) b c) IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) a (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A))) = twodeg k a * twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A))` [twodeg_mul] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) c (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))) = twodeg k c * twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))` [twodeg_mul] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) a (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A))) <= 2 EXP t * twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A))` [LE_MULT2;LE_REFL] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) c (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))) <= 2 EXP t * twodeg k (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))` [LE_MULT2;LE_REFL] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) a (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A))) < twodeg k A` [LET_TRANS] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) c (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))) < twodeg k A` [LET_TRANS] THEN
  have `twodeg(k:K ring) (ring_sub(x_ring k) (ring_mul(x_ring k) c (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))) (ring_mul(x_ring k) a (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A)))) < twodeg k A` [twodeg_sub_lt] THEN
  have `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) c (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A))) (ring_mul(x_ring k) a (ring_sub(x_ring k) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A))) = ring_mul(x_ring k) (ring_sub(x_ring k) (ring_mul(x_ring k) a d) (ring_mul(x_ring k) b c)) A` [RING_RULE `ring_sub(r:R ring) (ring_mul r c (ring_sub r (ring_mul r a B) (ring_mul r b A))) (ring_mul r a (ring_sub r (ring_mul r c B) (ring_mul r d A))) = ring_mul r (ring_sub r (ring_mul r a d) (ring_mul r b c)) A`] THEN
  have `twodeg(k:K ring) (ring_mul(x_ring k) (ring_sub(x_ring k) (ring_mul(x_ring k) a d) (ring_mul(x_ring k) b c)) A) < twodeg(k:K ring) A` [] THEN
  have `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) a d) (ring_mul(x_ring k) b c) = poly_0 k` [zero_if_twodeg_mul_lt_twodeg] THEN
  have `ring_mul(x_ring(k:K ring)) a d = ring_mul(x_ring k) b c` [x_ring_0;RING_RULE `ring_sub(r:R ring) x y = ring_0 r ==> x = y`] THEN
  simp[x_ring_lowest_terms_divides]
);;

(* ----- hamming_weight *)

let hamming_weight = new_definition(`
  hamming_weight (r:R ring) (e:X->R) S
  = CARD {x | x IN S /\ ~(e x = ring_0 r)}
`);;

(* ----- interpolation with errors *)

let interpolation_with_errors_lemma = prove(`
  !(k:K ring) S A B a b f e.
  integral_domain k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  f IN ring_carrier(x_ring k) ==>
  ring_coprime(x_ring k) (a,b) ==>
  ring_divides(x_ring k) a A ==>
  (!s. s IN S ==>
   e s = ring_sub k (poly_eval k s B) (poly_eval k s f)) ==>
  ring_mul(x_ring k) a f
  = ring_sub(x_ring k)
      (ring_mul(x_ring k) a B)
      (ring_mul(x_ring k) b A) ==>
  {s | s IN S /\ ~(e s = ring_0 k)}
  = {s | s IN S /\ poly_eval k s a = ring_0 k}
`,
  rw[EXTENSION;IN_ELIM_THM] THEN
  intro THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `poly_eval k x B IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k x b IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k x f IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  forwardreverse [
    STRIP_TAC THEN
    have `x IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `poly_eval k x A IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
    have `poly_eval k x a IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
    have `~(poly_eval(k:K ring) x B = poly_eval k x f)` [RING_SUB_EQ_0] THEN
    have `poly_eval(k:K ring) x A = ring_0 k` [monic_vanishing_at_vanishes] THEN
    have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    have `poly_eval(k:K ring) x (ring_mul(x_ring k) a f) = ring_mul k (poly_eval k x a) (poly_eval k x f)` [poly_eval_mul] THEN
    have `poly_eval(k:K ring) x (ring_mul(x_ring k) a B) = ring_mul k (poly_eval k x a) (poly_eval k x B)` [poly_eval_mul] THEN
    have `poly_eval(k:K ring) x (ring_mul(x_ring k) b A) = ring_mul k (poly_eval k x b) (poly_eval k x A)` [poly_eval_mul] THEN
    have `poly_eval(k:K ring) x (ring_sub(x_ring k) (ring_mul(x_ring k) a B) (ring_mul(x_ring k) b A)) = ring_sub k (poly_eval k x (ring_mul(x_ring k) a B)) (poly_eval k x (ring_mul(x_ring k) b A))` [poly_eval_sub] THEN
    have `ring_mul(k:K ring) (poly_eval k x a) (poly_eval k x f) = ring_sub k (ring_mul k (poly_eval k x a) (poly_eval k x B)) (ring_mul k (poly_eval k x b) (poly_eval k x A))` [] THEN
    have `poly_eval k x A = ring_0 k ==> ring_sub(k:K ring) (ring_mul k (poly_eval k x a) (poly_eval k x B)) (ring_mul k (poly_eval k x b) (poly_eval k x A)) = ring_mul k (poly_eval k x a) (poly_eval k x B)` [RING_RULE `A = ring_0(k:K ring) ==> ring_sub k (ring_mul k a B) (ring_mul k b A) = ring_mul k a B`] THEN
    have `ring_mul (k:K ring) (poly_eval k x a) (poly_eval k x f) = ring_mul k (poly_eval k x a) (poly_eval k x B)` [] THEN
    specialize_raw[`k:K ring`;`poly_eval(k:K ring) x a`;`poly_eval(k:K ring) x f`;`poly_eval(k:K ring) x B`]INTEGRAL_DOMAIN_MUL_LCANCEL THEN
    qed[]
  ; pass
  ]
  THEN
  STRIP_TAC THEN
  have `x IN ring_carrier(k:K ring)` [SUBSET] THEN
  def `L:(num->num)->K` `x_minus_const(k:K ring) x` THEN
  have `L IN ring_carrier(x_ring(k:K ring))` [x_minus_const_in_x_ring] THEN
  have `ring_divides(x_ring(k:K ring)) L a` [x_minus_const_divides_if_root] THEN
  choose `aL:(num->num)->K` `aL IN ring_carrier(x_ring k) /\ a = ring_mul(x_ring(k:K ring)) L aL` [ring_divides] THEN
  def `AL:(num->num)->K` `monic_vanishing_at_except(k:K ring) S x` THEN
  have `AL IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_except_in_x_ring] THEN
  have `A = ring_mul(x_ring(k:K ring)) L AL` [missing_times_monic_vanishing_at_except] THEN
  have `ring_divides(x_ring(k:K ring)) L A` [ring_divides] THEN
  have `~(A:(num->num)->K = poly_0 k)` [monic_vanishing_at_nonzero] THEN
  have `~(L:(num->num)->K = poly_0 k)` [ring_nonzero_if_divides_nonzero;x_ring_0] THEN
  have `ring_mul(x_ring(k:K ring)) L (ring_mul(x_ring k) b AL) = ring_mul(x_ring k) L (ring_mul(x_ring k) aL (ring_sub(x_ring k) B f))` [RING_RULE `ring_mul(r:R ring) a f = ring_sub r (ring_mul r a B) (ring_mul r b A) ==> A = ring_mul r L AL ==> a = ring_mul r L aL ==> ring_mul r L (ring_mul r b AL) = ring_mul r L (ring_mul r aL (ring_sub r B f))`] THEN
  have `ring_mul(x_ring(k:K ring)) b AL IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_sub(x_ring(k:K ring)) B f IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring(k:K ring)) aL (ring_sub(x_ring k) B f) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `integral_domain(x_ring(k:K ring))` [x_ring_domain] THEN
  specialize_raw[`x_ring(k:K ring)`;`L:(num->num)->K`;`ring_mul(x_ring(k:K ring)) b AL`;`ring_mul(x_ring(k:K ring)) aL (ring_sub(x_ring k) B f)`]INTEGRAL_DOMAIN_MUL_LCANCEL THEN
  have `ring_mul(x_ring(k:K ring)) b AL = ring_mul(x_ring k) aL (ring_sub(x_ring k) B f)` [x_ring_0] THEN
  have `poly_eval k x AL IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k x aL IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `~(poly_eval k x b = ring_0(k:K ring))` [not_coprime_if_shared_root] THEN
  have `~(poly_eval(k:K ring) x AL = ring_0 k)` [eval_monic_vanishing_at_except_nonzero] THEN
  have `poly_eval(k:K ring) x (ring_mul(x_ring k) b AL) = ring_mul k (poly_eval k x b) (poly_eval k x AL)` [poly_eval_mul] THEN
  have `~(poly_eval(k:K ring) x (ring_mul(x_ring k) b AL) = ring_0 k)` [integral_domain] THEN
  have `~(poly_eval(k:K ring) x (ring_mul(x_ring k) aL (ring_sub(x_ring k) B f)) = ring_0 k)` [] THEN
  have `poly_eval(k:K ring) x (ring_mul(x_ring k) aL (ring_sub(x_ring k) B f)) = ring_mul k (poly_eval k x aL) (poly_eval k x (ring_sub(x_ring k) B f))` [poly_eval_mul] THEN
  have `~(ring_mul(k:K ring) (poly_eval k x aL) (poly_eval k x (ring_sub(x_ring k) B f)) = ring_0 k)` [] THEN
  have `~(poly_eval(k:K ring) x (ring_sub(x_ring k) B f) = ring_0 k)` [ring_mul_0] THEN
  have `poly_eval(k:K ring) x (ring_sub(x_ring k) B f) = ring_sub k (poly_eval k x B) (poly_eval k x f)` [poly_eval_sub] THEN
  qed[]
);;

let interpolation_with_errors = prove(`
  !(k:K ring) S A B t a b f e aBbA.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==>
  approximant k A B t a b ==>
  f IN ring_carrier(x_ring k) ==>
  2 EXP (2*t) * twodeg k f < twodeg k A ==>
  (!s. s IN S ==>
   e s = ring_sub k (poly_eval k s B) (poly_eval k s f)) ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  hamming_weight k e S <= t ==>
     ring_divides(x_ring k) a A
  /\ ~(a = poly_0 k)
  /\ ring_mul(x_ring k) a f = aBbA
  /\ 2 EXP (2*t) * twodeg k aBbA < twodeg k A * twodeg k a
  /\ {s | s IN S /\ ~(e s = ring_0 k)}
     = {s | s IN S /\ poly_eval k s a = ring_0 k}
`,
  REPEAT GEN_TAC THEN
  REPEAT DISCH_TAC THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  have `B IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  have `b IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  have `ring_coprime(x_ring(k:K ring)) (a,b)` [approximant] THEN
  have `twodeg(k:K ring) a <= 2 EXP t` [approximant] THEN
  have `2 EXP t * twodeg(k:K ring) aBbA < twodeg k A` [approximant] THEN
  specialize[`S:K->bool`;`\s:K. e s = ring_0(k:K ring)`]filter_union_filternot THEN
  specialize[`S:K->bool`;`\s:K. e s = ring_0(k:K ring)`]filter_disjoint_filternot THEN
  have `!s:K. s IN S ==> s IN ring_carrier k` [SUBSET] THEN
  have `!s:K. s IN S ==> e s = ring_0(k:K ring) ==> poly_eval k s (ring_sub(x_ring k) B f) = ring_0 k` [poly_eval_sub] THEN
  set_tac `!s:K. s IN {s | s IN S /\ e s = ring_0 k} ==> s IN S /\ e s = ring_0(k:K ring)` [] THEN
  have `!s:K. s IN {s | s IN S /\ e s = ring_0 k} ==> poly_eval k s (ring_sub(x_ring k) B f) = ring_0 k` [] THEN
  have `FINITE {s:K | s IN S /\ e s = ring_0(k:K ring)}` [FINITE_UNION] THEN
  have `FINITE {s:K | s IN S /\ ~(e s = ring_0(k:K ring))}` [FINITE_UNION] THEN
  have `{s:K | s IN S /\ e s = ring_0(k:K ring)} SUBSET ring_carrier k` [UNION_SUBSET] THEN
  have `{s:K | s IN S /\ ~(e s = ring_0(k:K ring))} SUBSET ring_carrier k` [UNION_SUBSET] THEN
  def `E:(num->num)->K` `monic_vanishing_at(k:K ring) {s:K | s IN S /\ e s = ring_0 k}` THEN
  have `E IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  def `c:(num->num)->K` `monic_vanishing_at(k:K ring) {s:K | s IN S /\ ~(e s = ring_0 k)}` THEN
  have `c IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `twodeg(k:K ring) c = 2 EXP (hamming_weight k e (S:K->bool))` [twodeg_monic_vanishing_at;hamming_weight] THEN
  specialize[`k:K ring`;`{s:K | s IN S /\ e s = ring_0(k:K ring)}`;`{s:K | s IN S /\ ~(e s = ring_0(k:K ring))}`;`S:K->bool`]monic_vanishing_at_union THEN
  have `ring_mul(x_ring(k:K ring)) E c = A` [] THEN
  have `ring_sub(x_ring k) B f IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_divides(x_ring(k:K ring)) E (ring_sub(x_ring k) B f)` [monic_vanishing_at_divides_if_roots]
  THEN
  choose `d:(num->num)->K` `d IN ring_carrier(x_ring k) /\ ring_sub(x_ring(k:K ring)) B f = ring_mul(x_ring k) E d` [ring_divides] THEN
  have `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A) = ring_mul(x_ring k) c f` [RING_RULE `ring_sub(r:R ring) B f = ring_mul r E d ==> ring_mul r E c = A ==> ring_sub r (ring_mul r c B) (ring_mul r d A) = ring_mul r c f`] THEN
  have `twodeg k (ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A)) = twodeg k c * twodeg k f` [twodeg_mul] THEN
  have `twodeg(k:K ring) c <= 2 EXP t` [twopow_mono_le] THEN
  have `twodeg k (ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A)) <= 2 EXP t * twodeg k f` [LE_MULT2;LE_REFL] THEN
  have `2 EXP t * twodeg k (ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A)) <= 2 EXP t * (2 EXP t * twodeg k f)` [LE_MULT2;LE_REFL] THEN
  have `2 EXP t * (2 EXP t * twodeg(k:K ring) f) = 2 EXP (t+t) * twodeg(k:K ring) f` [MULT_ASSOC;EXP_ADD] THEN
  have `2 EXP (t+t) * twodeg(k:K ring) f < twodeg k A` [ARITH_RULE `2*t = t+t`] THEN
  have `2 EXP t * twodeg k (ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) c B) (ring_mul(x_ring k) d A)) < twodeg k A` [LET_TRANS] THEN
  have `d IN ring_carrier(x_ring(k:K ring))` [] THEN
  specialize[`k:K ring`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`;`a:(num->num)->K`;`b:(num->num)->K`;`c:(num->num)->K`;`d:(num->num)->K`]approximant_best THEN
  choose `L:(num->num)->K` `L IN ring_carrier (x_ring(k:K ring)) /\ c = ring_mul (x_ring k) a L /\ d = ring_mul (x_ring k) b L` [] THEN
  have `ring_divides(x_ring(k:K ring)) a c` [ring_divides] THEN
  have `ring_mul(x_ring(k:K ring)) L a = c` [RING_MUL_SYM] THEN
  have `ring_divides(x_ring(k:K ring)) L c` [ring_divides] THEN
  have `ring_mul(x_ring(k:K ring)) c E = A` [RING_MUL_SYM] THEN
  have `ring_divides(x_ring(k:K ring)) c A` [ring_divides] THEN
  have `ring_divides(x_ring(k:K ring)) a A` [RING_DIVIDES_TRANS] THEN
  have `ring_divides(x_ring(k:K ring)) L A` [RING_DIVIDES_TRANS] THEN
  have `~(A:(num->num)->K = poly_0 k)` [monic_vanishing_at_nonzero] THEN
  have `~(a:(num->num)->K = poly_0 k)` [ring_nonzero_if_divides_nonzero;x_ring_0] THEN
  have `~(L:(num->num)->K = poly_0 k)` [ring_nonzero_if_divides_nonzero;x_ring_0] THEN
  have `ring_mul(x_ring(k:K ring)) L (ring_mul(x_ring k) a f) = ring_mul(x_ring k) L aBbA` [RING_RULE `ring_sub r (ring_mul r c B) (ring_mul r d A) = ring_mul r c f ==> c = ring_mul r a L ==> d = ring_mul r b L ==> ring_mul(r:R ring) L (ring_mul r a f) = ring_mul r L (ring_sub r (ring_mul r a B) (ring_mul r b A))`] THEN
  have `ring_mul(x_ring k) a f IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `aBbA IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `integral_domain(x_ring(k:K ring))` [x_ring_domain] THEN
  specialize_raw[`x_ring(k:K ring)`;`L:(num->num)->K`;`ring_mul(x_ring(k:K ring)) a f`;`aBbA:(num->num)->K`]INTEGRAL_DOMAIN_MUL_LCANCEL THEN
  have `ring_mul(x_ring(k:K ring)) a f = aBbA` [x_ring_0] THEN
  have `ring_mul(x_ring(k:K ring)) a f = ring_sub (x_ring k) (ring_mul (x_ring k) a B) (ring_mul (x_ring k) b A)` [] THEN
  have `twodeg(k:K ring) a * twodeg k f = twodeg k aBbA` [twodeg_mul] THEN
  have `2 EXP (2*t) * twodeg(k:K ring) aBbA = (2 EXP (2*t) * twodeg k f) * twodeg k a` [ARITH_RULE `(c:num) * (d * e) = (c * e) * d`] THEN
  have `~(twodeg(k:K ring) a = 0)` [twodeg_only_0] THEN
  have `(2 EXP (2*t) * twodeg(k:K ring) f) * twodeg k a < twodeg k A * twodeg k a` [lt_rmult] THEN
  specialize[`k:K ring`;`S:K->bool`;`A:(num->num)->K`;`B:(num->num)->K`;`a:(num->num)->K`;`b:(num->num)->K`;`f:(num->num)->K`;`e:K->K`]interpolation_with_errors_lemma THEN
  qed[]
);;

let checking_interpolation_with_errors = prove(`
  !(k:K ring) S A B t a b f.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  f IN ring_carrier(x_ring k) ==>
  twodeg k a <= 2 EXP t ==>
  ring_divides(x_ring k) a A ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  2 EXP (2*t) * twodeg k aBbA < twodeg k A * twodeg k a ==>
  ring_mul(x_ring k) a f = aBbA ==>
  (   2 EXP (2*t) * twodeg k f < twodeg k A
   /\ hamming_weight k
        (\s. ring_sub k (poly_eval k s B) (poly_eval k s f))
        S <= t
  )
`,
  REPEAT GEN_TAC THEN
  REPEAT DISCH_TAC THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `twodeg(k:K ring) a * twodeg k f = twodeg k aBbA` [twodeg_mul] THEN
  have `2 EXP (2*t) * (twodeg(k:K ring) a * twodeg k f) < twodeg k A * twodeg k a` [] THEN
  num_linear `2 EXP (2*t) * (twodeg(k:K ring) a * twodeg k f) < twodeg k A * twodeg k a ==> (2 EXP (2*t) * twodeg k f) * twodeg k a < twodeg k A * twodeg k a` THEN
  have `2 EXP (2*t) * twodeg(k:K ring) f < twodeg k A` [LT_MULT_RCANCEL] THEN
  have `ring_mul(x_ring k) a B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `aBbA IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring(k:K ring)) a (ring_sub(x_ring k) B f) = ring_mul(x_ring k) b A` [RING_RULE `ring_mul(r:R ring) a f = aBbA ==> aBbA = ring_sub r (ring_mul r a B) (ring_mul r b A) ==> ring_mul r a (ring_sub r B f) = ring_mul r b A`] THEN
  have `ring_sub(x_ring k) B f IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `!s:K. s IN S ==> s IN ring_carrier k` [SUBSET] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_sub(x_ring k) B f) = ring_sub k (poly_eval k s B) (poly_eval k s f)` [poly_eval_sub] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_mul(x_ring k) a (ring_sub(x_ring k) B f)) = ring_mul k (poly_eval k s a) (poly_eval k s (ring_sub(x_ring k) B f))` [poly_eval_mul] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_mul(x_ring k) a (ring_sub(x_ring k) B f)) = ring_mul k (poly_eval k s a) (ring_sub k (poly_eval k s B) (poly_eval k s f))` [] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_mul(x_ring k) b A) = ring_mul k (poly_eval k s a) (ring_sub k (poly_eval k s B) (poly_eval k s f))` [] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_mul(x_ring k) b A) = ring_mul k (poly_eval k s b) (poly_eval k s A)` [poly_eval_mul] THEN
  have `!s:K. s IN S ==> poly_eval k s A = ring_0 k` [monic_vanishing_at_vanishes] THEN
  have `!s:K. s IN S ==> poly_eval k s b IN ring_carrier k` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_mul(x_ring k) b A) = ring_0 k` [ring_mul_0] THEN
  have `!s:K. s IN S ==> ring_mul k (poly_eval k s a) (ring_sub k (poly_eval k s B) (poly_eval k s f)) = ring_0 k` [] THEN
  have `!s:K. s IN S ==> poly_eval k s f IN ring_carrier k` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> poly_eval k s a IN ring_carrier k` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> poly_eval k s B IN ring_carrier k` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> ring_sub k (poly_eval k s B) (poly_eval k s f) IN ring_carrier k` [RING_SUB] THEN
  have `!s:K. s IN S ==> ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k) ==> poly_eval k s a = ring_0 k` [INTEGRAL_DOMAIN_MUL_EQ_0] THEN
  have `!s:K. s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k) ==> s IN S /\ poly_eval k s a = ring_0 k` [] THEN
  set_tac `{s:K | s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)} SUBSET {s:K | s IN S /\ poly_eval k s a = ring_0 k} <=> !s:K. s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k) ==> s IN S /\ poly_eval k s a = ring_0 k` [] THEN
  def `Z:K->bool` `{s:K | s IN S /\ poly_eval k s a = ring_0 k}` THEN
  have `{s:K | s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)} SUBSET Z` [] THEN
  specialize[`S:K->bool`;`\s:K. poly_eval k s a = ring_0 k`]SUBSET_RESTRICT THEN
  have `Z SUBSET (S:K->bool)` [] THEN
  have `FINITE (Z:K->bool)` [FINITE_SUBSET] THEN
  have `(Z:K->bool) SUBSET ring_carrier k` [SUBSET_TRANS] THEN
  set_tac `!s:K. s IN {s:K | s IN S /\ poly_eval k s a = ring_0 k} ==> poly_eval k s a = ring_0 k` [] THEN
  have `!s:K. s IN Z ==> poly_eval k s a = ring_0 k` [] THEN
  have `~(A:(num->num)->K = poly_0 k)` [monic_vanishing_at_nonzero] THEN
  have `~(a:(num->num)->K = poly_0 k)` [ring_nonzero_if_divides_nonzero;x_ring_0] THEN
  have `2 EXP CARD(Z:K->bool) <= twodeg(k:K ring) a` [roots_le_twodeg] THEN
  have `2 EXP CARD(Z:K->bool) <= 2 EXP t` [LE_TRANS] THEN
  have `CARD(Z:K->bool) <= t` [twopow_mono_le] THEN
  have `CARD {s:K | s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)} <= CARD(Z:K->bool)` [CARD_SUBSET] THEN
  have `CARD {s:K | s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)} <= t` [LE_TRANS] THEN
  rw[hamming_weight] THEN
  simp[]
);;

(* ----- monomial shift *)

let monomial_shift = new_definition `
  monomial_shift (m:num->num)
  = (\v. if v = 0 then m v + 1 else m v)
`;;

let monomial_shift_eq_map0to = prove(`
  !m d.
  monomial_shift m = map0to d
  <=>
  (?c. d = c + 1 /\ m = map0to c)
`,
  rw[monomial_shift;map0to;FUN_EQ_THM] THEN
  intro THEN
  EQ_TAC THENL [
    intro THEN
    EXISTS_TAC `m 0:num` THEN
    qed[]
  ;
    intro THEN
    qed[]
  ]
);;

let monomial_shift_is_not_monomial_1 = prove(`
  !m.
  ~(monomial_shift m = monomial_1)
`,
  rw[monomial_shift;monomial_1;FUN_EQ_THM;NOT_FORALL_THM] THEN
  intro THEN
  EXISTS_TAC `0` THEN
  ASM_ARITH_TAC
);;

let monomial_shift_mul = prove(`
  !m n.
  monomial_mul (monomial_shift m) n
  = monomial_shift (monomial_mul m n)
`,
  rw[FUN_EQ_THM] THEN
  rw[monomial_mul;monomial_shift] THEN
  ARITH_TAC
);;

let monomial_mul_shift = prove(`
  !m n.
  monomial_mul m (monomial_shift n)
  = monomial_shift (monomial_mul m n)
`,
  rw[FUN_EQ_THM] THEN
  rw[monomial_mul;monomial_shift] THEN
  ARITH_TAC
);;

let monomial_shift_infinite = prove(`
  !m.
  INFINITE(monomial_vars m) ==>
  INFINITE(monomial_vars(monomial_shift m))
`,
  rw[monomial_shift;monomial_vars] THEN
  intro THEN
  have `!i:num. ~(m i = 0) ==> ~((if i = 0 then m i + 1 else m i) = 0)` [ARITH_RULE `~(m = 0) ==> ~(m + 1 = 0)`] THEN
  set_tac `(!i:num. ~(m i = 0) ==> ~((if i = 0 then m i + 1 else m i) = 0)) ==> {i | ~(m i = 0)} SUBSET {i | ~((if i = 0 then m i + 1 else m i) = 0)}` [] THEN
  qed[INFINITE_SUPERSET]
);;

let monomial_shift_injective = prove(`
  !m n.
  monomial_shift m = monomial_shift n ==>
  m = n
`,
  rw[monomial_shift;FUN_EQ_THM] THEN
  qed[ARITH_RULE `m + 1 = n + 1 ==> m = n`]
);;

let monomial_vars_subset_shift = prove(`
  !m. monomial_vars m SUBSET monomial_vars (monomial_shift m)
`,
  rw[SUBSET;monomial_vars;IN_ELIM_THM;monomial_shift] THEN
  qed[ARITH_RULE `~(m = 0) ==> ~(m + 1 = 0)`]
);;

(* ----- derivatives *)

let x_derivative = new_definition `
  x_derivative (r:R ring) (p:(num->num)->R)
  = (\m. ring_mul r
          (ring_of_num r (m 0 + 1))
          (p (monomial_shift m)))
`;;

let x_derivative_powerseries = prove(`
  !(r:R ring) p.
  ring_powerseries r p ==>
  ring_powerseries r (x_derivative r p)
`,
  rw[ring_powerseries;x_derivative] THEN
  intro THENL [
    qed[RING_OF_NUM;RING_MUL]
  ;
    have `INFINITE (monomial_vars (monomial_shift m))` [monomial_shift_infinite] THEN
    qed[RING_OF_NUM;ring_mul_0]
  ]
);;

let x_derivative_polynomial = prove(`
  !(r:R ring) p.
  ring_polynomial r p ==>
  ring_polynomial r (x_derivative r p)
`,
  rw[ring_polynomial] THEN
  intro THENL [
    qed[x_derivative_powerseries]
  ;
    rw[x_derivative] THEN
    have `!m. ~(ring_mul(r:R ring) (ring_of_num r (m 0 + 1)) (p (monomial_shift m)) = ring_0 r) ==> ~(p (monomial_shift m) = ring_0 r)` [ring_mul_0;RING_OF_NUM] THEN
    set_tac `(!m. ~(ring_mul(r:R ring) (ring_of_num r (m 0 + 1)) (p (monomial_shift m)) = ring_0 r) ==> ~(p (monomial_shift m) = ring_0 r)) ==> {m | ~(ring_mul(r:R ring) (ring_of_num r (m 0 + 1)) (p (monomial_shift m)) = ring_0 r)} SUBSET {m | ~(p (monomial_shift m) = ring_0 r)}` [] THEN
    have `{m | ~(ring_mul(r:R ring) (ring_of_num r (m 0 + 1)) (p (monomial_shift m)) = ring_0 r)} SUBSET {m | ~(p (monomial_shift m) = ring_0 r)}` [] THEN
    specialize_raw[`monomial_shift`;`{m:num->num | ~(p m = ring_0(r:R ring))}`]FINITE_IMAGE_INJ THEN
    have `FINITE {m | monomial_shift m IN {m | ~(p m = ring_0(r:R ring))}}` [monomial_shift_injective] THEN
    set_tac `{m | monomial_shift m IN {m | ~(p m = ring_0(r:R ring))}} = {m | ~(p (monomial_shift m) = ring_0(r:R ring))}` [] THEN
    have `FINITE {m | ~(p (monomial_shift m) = ring_0(r:R ring))}` [] THEN
    qed[FINITE_SUBSET]
  ]
);;

let x_derivative_poly_vars_subset = prove(`
  !(r:R ring) p (S:num->bool).
  poly_vars r (x_derivative r p) SUBSET poly_vars r p
`,
  rw[SUBSET;poly_vars;UNIONS;IN_ELIM_THM;x_derivative] THEN
  intro THEN
  have `~(p (monomial_shift m) = ring_0(r:R ring))` [ring_mul_0;RING_OF_NUM] THEN
  EXISTS_TAC `monomial_vars (monomial_shift m)` THEN
  intro THENL [
    EXISTS_TAC `monomial_shift m` THEN
    qed[]
  ;
    qed[monomial_vars_subset_shift;SUBSET]
  ]
);;

let x_derivative_poly_vars = prove(`
  !(r:R ring) p (S:num->bool).
  poly_vars r p SUBSET S ==>
  poly_vars r (x_derivative r p) SUBSET S
`,
  qed[x_derivative_poly_vars_subset;SUBSET_TRANS]
);;

let x_derivative_in_x_ring = prove(`
  !(r:R ring) p.
  p IN ring_carrier(x_ring r) ==>
  x_derivative r p IN ring_carrier(x_ring r)
`,
  rw[x_ring_carrier;IN_ELIM_THM] THEN
  qed[x_derivative_polynomial;x_derivative_poly_vars]
);;

let x_derivative_add_powerseries = prove(`
  !(r:R ring) p q.
  ring_powerseries r p ==>
  ring_powerseries r q ==>
  x_derivative r (poly_add r p q)
  = poly_add r (x_derivative r p) (x_derivative r q)
`,
  intro THEN
  have `!m:num->num. p m IN ring_carrier(r:R ring)` [ring_powerseries] THEN
  have `!m:num->num. q m IN ring_carrier(r:R ring)` [ring_powerseries] THEN
  rw[x_derivative;poly_add] THEN
  once_rw[FUN_EQ_THM] THEN
  simp[RING_ADD_LDISTRIB;RING_OF_NUM]
);;

let x_derivative_neg_powerseries = prove(`
  !(r:R ring) p.
  ring_powerseries r p ==>
  x_derivative r (poly_neg r p)
  = poly_neg r (x_derivative r p)
`,
  intro THEN
  have `!m:num->num. p m IN ring_carrier(r:R ring)` [ring_powerseries] THEN
  rw[x_derivative;poly_neg] THEN
  once_rw[FUN_EQ_THM] THEN
  simp[RING_MUL_RNEG;RING_OF_NUM]
);;

let x_derivative_poly_const_mul_powerseries = prove(`
  !(r:R ring) c p.
  c IN ring_carrier r ==>
  ring_powerseries r p ==>
  x_derivative r (poly_mul r (poly_const r c) p)
  = poly_mul r (poly_const r c) (x_derivative r p)
`,
  simp[poly_const_mul_expand;x_derivative_powerseries] THEN
  rw[x_derivative] THEN
  once_rw[FUN_EQ_THM] THEN
  intro THEN
  simp[] THEN
  have `ring_of_num(r:R ring) (x 0 + 1) IN ring_carrier r` [RING_OF_NUM] THEN
  have `p (monomial_shift x) IN ring_carrier(r:R ring)` [ring_powerseries] THEN
  RING_TAC
);;

let x_derivative_add = prove(`
  !(r:R ring) p q.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_add(x_ring r) p q)
  = ring_add(x_ring r) (x_derivative r p) (x_derivative r q)
`,
  qed[x_derivative_add_powerseries;x_ring_add;in_x_ring_carrier_implies_powerseries]
);;

let x_derivative_neg = prove(`
  !(r:R ring) p.
  p IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_neg(x_ring r) p)
  = ring_neg(x_ring r) (x_derivative r p)
`,
  qed[x_derivative_neg_powerseries;x_ring_neg;in_x_ring_carrier_implies_powerseries]
);;

let x_derivative_sub = prove(`
  !(r:R ring) p q.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_sub(x_ring r) p q)
  = ring_sub(x_ring r) (x_derivative r p) (x_derivative r q)
`,
  intro THEN
  have `ring_neg(x_ring(r:R ring)) q IN ring_carrier(x_ring r)` [RING_NEG] THEN
  qed[x_derivative_add;x_derivative_neg;ring_sub]
);;

let x_derivative_poly_const = prove(`
  !(r:R ring) c.
  x_derivative r (poly_const r c) = poly_0 r
`,
  rw[x_derivative;poly_0;poly_const;monomial_shift_is_not_monomial_1;COND_ID] THEN
  once_rw[FUN_EQ_THM] THEN
  intro THEN
  qed[RING_OF_NUM;ring_mul_0]
);;

let x_derivative_0 = prove(`
  !(r:R ring).
  x_derivative r (poly_0 r) = poly_0 r
`,
  qed[poly_0;x_derivative_poly_const]
);;

let x_derivative_1 = prove(`
  !(r:R ring).
  x_derivative r (poly_1 r) = poly_0 r
`,
  qed[poly_1;x_derivative_poly_const]
);;

let x_derivative_sum = prove(`
  !(r:R ring) f (S:X->bool).
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  x_derivative r (ring_sum(x_ring r) S f)
  = ring_sum(x_ring r) S (x_derivative r o f)
`,
  GEN_TAC THEN GEN_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    qed[RING_SUM_CLAUSES;x_derivative_0;x_ring_0]
  ;
    set_tac `(x:X) IN x INSERT S` [] THEN
    have `f (x:X) IN ring_carrier(x_ring(r:R ring))` [] THEN
    set_tac `!s:X. s IN S ==> s IN x INSERT S` [] THEN
    have `!s:X. s IN S ==> f s IN ring_carrier(x_ring(r:R ring))` [] THEN
    have `(x_derivative r o f) (x:X) IN ring_carrier(x_ring(r:R ring))` [o_THM;x_derivative_in_x_ring] THEN
    simp[RING_SUM_CLAUSES;o_THM] THEN
    simp[x_derivative_add;RING_SUM]
  ]
);;

let x_derivative_poly_const_mul = prove(`
  !(r:R ring) c p.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_mul(x_ring r) (poly_const r c) p)
  = ring_mul(x_ring r) (poly_const r c) (x_derivative r p)
`,
  qed[x_derivative_poly_const_mul_powerseries;x_ring_mul;in_x_ring_carrier_implies_powerseries]
);;

let x_derivative_x_pow = prove(`
  !(r:R ring) d.
  x_derivative r (x_pow r d)
  = const_x_pow r (ring_of_num r d) (d-1)
`,
  rw[x_derivative;x_pow;monomial_shift_eq_map0to] THEN
  once_rw[FUN_EQ_THM] THEN
  simp[const_x_pow_expand;RING_OF_NUM] THEN
  intro THEN
  ASM_CASES_TAC `d = 0` THENL [
    num_linear `~(?c. 0 = c + 1 /\ x = map0to c)` THEN
    simp[RING_OF_NUM_0;COND_ID;RING_OF_NUM;ring_mul_0]
  ;
    num_linear `~(d = 0) ==> d = (d-1) + 1` THEN
    ASM_CASES_TAC `x = map0to(d - 1)` THENL [
      have `x 0 = d - 1` [map0to] THEN
      have `x 0 + 1 = d` [] THEN
      have `ring_mul(r:R ring) (ring_of_num r d) (ring_1 r) = ring_of_num r d` [RING_OF_NUM;ring_mul_1] THEN
      qed[]
    ;
      have `!c. d = c + 1 ==> ~(x = map0to c)` [ARITH_RULE `d = c + 1 ==> c = d - 1`] THEN
      qed[RING_OF_NUM;ring_mul_0]
    ]
  ]
);;

let x_derivative_const_x_pow = prove(`
  !(r:R ring) d.
  c IN ring_carrier r ==>
  x_derivative r (const_x_pow r c d)
  = const_x_pow r (ring_mul r (ring_of_num r d) c) (d-1)
`,
  intro THEN
  rw[const_x_pow] THEN
  rw[GSYM x_ring_mul] THEN
  have `x_pow (r:R ring) d IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  simp[x_derivative_poly_const_mul;x_derivative_x_pow] THEN
  rw[const_x_pow] THEN
  rw[GSYM x_ring_mul] THEN
  have `poly_const(r:R ring) c IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `ring_of_num r d IN ring_carrier(r:R ring)` [RING_OF_NUM] THEN
  have `poly_const(r:R ring) (ring_of_num r d) IN ring_carrier(x_ring r)` [poly_const_in_x_ring] THEN
  have `x_pow (r:R ring) (d-1) IN ring_carrier(x_ring r)` [x_pow_in_x_ring] THEN
  simp[RING_MUL_ASSOC] THEN
  rw[x_ring_mul] THEN
  simp[GSYM POLY_CONST_MUL] THEN
  qed[RING_MUL_SYM]
);;

let x_derivative_expand_twodeg = prove(`
  !(r:R ring) p H.
  p IN ring_carrier(x_ring r) ==>
  twodeg r p <= H ==>
  x_derivative r p
  = ring_sum (x_ring r)
      {d | 2 EXP d <= H}
      (\d. const_x_pow r
             (ring_mul r (ring_of_num r d) (coeff d p))
             (d-1))
`,
  intro THEN
  have `p = ring_sum(x_ring(r:R ring)) {d | 2 EXP d <= H} (\d. const_x_pow r (coeff d p) d)` [x_ring_expand_twodeg] THEN
  have `FINITE {d | 2 EXP d <= H}` [twopow_finite] THEN
  have `!d. coeff d p IN ring_carrier(r:R ring)` [coeff_in_ring] THEN
  have `!d. d IN {d | 2 EXP d <= H} ==> const_x_pow r (coeff d p) d IN ring_carrier(x_ring(r:R ring))` [const_x_pow_in_x_ring] THEN
  have `x_derivative r p = ring_sum(x_ring(r:R ring)) {d | 2 EXP d <= H} (x_derivative r o (\d. const_x_pow r (coeff d p) d))` [x_derivative_sum] THEN
  have `!d. (x_derivative (r:R ring) o (\d. const_x_pow r (coeff d p) d)) d = (\d. const_x_pow r (ring_mul r (ring_of_num r d) (coeff d p)) (d-1)) d` [o_THM;x_derivative_const_x_pow] THEN
  have `(x_derivative (r:R ring) o (\d. const_x_pow r (coeff d p) d)) = (\d. const_x_pow r (ring_mul r (ring_of_num r d) (coeff d p)) (d-1))` [FUN_EQ_THM] THEN
  qed[]
);;

let coeff_x_derivative = prove(`
  !(r:R ring) p d.
  coeff d (x_derivative r p)
  = ring_mul r (ring_of_num r (d+1)) (coeff (d+1) p)
`,
  intro THEN
  rw[x_derivative;coeff] THEN
  have `monomial_shift (map0to d) = map0to (d+1)` [monomial_shift_eq_map0to] THEN
  simp[] THEN
  rw[map0to]
);;

let coeff_x_derivative_poly_mul = prove(`
  !(r:R ring) p q d.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  coeff d (x_derivative r (poly_mul r p q)) 
  = ring_add r
      (coeff d (poly_mul r (x_derivative r p) q))
      (coeff d (poly_mul r p (x_derivative r q)))
`,
  rw[coeff_x_derivative;coeff_mul_poly_oneindex] THEN
  intro THEN
  have `!i. coeff i p IN ring_carrier(r:R ring)` [coeff_in_ring] THEN
  have `!i. coeff i q IN ring_carrier(r:R ring)` [coeff_in_ring] THEN
  have `ring_0(r:R ring) = ring_mul r (ring_mul r (ring_of_num r 0) (coeff 0 p)) (coeff ((d + 1) - 0) q)` [RING_OF_NUM_0;ring_0_mul] THEN
  specialize[`r:R ring`;`\a. ring_mul(r:R ring) (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d+1)-a) q)`;`d:num`](GSYM ring_sum_shift1) THEN
  specialize[`d+1`]FINITE_NUMSEG_LE THEN
  have `ring_of_num(r:R ring) (d+1) IN ring_carrier r` [RING_OF_NUM] THEN
  have `!a. a IN {a | a <= d+1} ==> ring_mul r (coeff a p) (coeff ((d + 1) - a) q) IN ring_carrier(r:R ring)` [RING_MUL] THEN
  set_tac `!a:num. a IN {a | a <= d} ==> a <= d` [] THEN
  num_linear `!a:num. a <= d ==> d - a = (d+1)-(a+1)` THEN
  have `!a:num. a IN {a | a <= d} ==> d - a = (d+1)-(a+1)` [] THEN
  specialize[`r:R ring`;`\a. ring_mul (r:R ring) (coeff a p) (coeff ((d+1)-a) q)`;`ring_of_num(r:R ring) (d+1)`;`{a | a <= d+1}`](GSYM RING_SUM_LMUL) THEN
  num_linear `!a:num. a <= d ==> d-a+1 = (d+1)-a` THEN
  have `!a:num. a IN {a | a <= d} ==> d-a+1 = (d+1)-a` [] THEN
  have `ring_of_num r ((d+1)-(d+1)) = ring_0(r:R ring)` [RING_OF_NUM_0;ARITH_RULE `(d+1)-(d+1)=0`] THEN
  have `ring_0(r:R ring) = ring_mul r (coeff (d+1) p) (ring_mul r (ring_of_num r ((d+1)-(d+1))) (coeff ((d+1)-(d+1)) q))` [RING_OF_NUM;ring_0_mul;ring_mul_0] THEN
  specialize[`r:R ring`;`\a. ring_mul(r:R ring) (coeff a p) (ring_mul r (ring_of_num r ((d+1)-a)) (coeff ((d+1)-a) q))`;`d:num`](GSYM ring_sum_insert_top) THEN
  simp[] THEN
  have `!a. ring_mul r (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d + 1) - a) q) IN ring_carrier(r:R ring)` [RING_OF_NUM;RING_MUL] THEN
  have `!a. ring_mul r (coeff a p) (ring_mul r (ring_of_num r ((d + 1) - a)) (coeff ((d + 1) - a) q)) IN ring_carrier(r:R ring)` [RING_OF_NUM;RING_MUL] THEN
  simp[GSYM RING_SUM_ADD] THEN
  have `!a. ring_add(r:R ring) (ring_mul r (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d+1)-a) q)) (ring_mul r (coeff a p) (ring_mul r (ring_of_num r ((d+1)-a)) (coeff ((d+1)-a) q))) = ring_mul r (ring_add r (ring_of_num r a) (ring_of_num r ((d+1)-a))) (ring_mul r (coeff a p) (coeff ((d+1)-a) q))` [RING_RULE `ring_add(r:R ring) (ring_mul r (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d+1)-a) q)) (ring_mul r (coeff a p) (ring_mul r (ring_of_num r ((d+1)-a)) (coeff ((d+1)-a) q))) = ring_mul r (ring_add r (ring_of_num r a) (ring_of_num r ((d+1)-a))) (ring_mul r (coeff a p) (coeff ((d+1)-a) q))`] THEN
  simp[GSYM RING_OF_NUM_ADD] THEN
  num_linear `!a. a <= d + 1 ==> a + (d+1) - a = d+1` THEN
  set_tac `!a. a IN {a | a <= d+1} ==> a <= d+1` [] THEN
  have `!a. a IN {a | a <= d+1} ==> a+(d+1)-a = d+1` [] THEN
  simp[]
);;

let coeff_x_derivative_mul = prove(`
  !(r:R ring) p q d.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  coeff d (x_derivative r (ring_mul(x_ring r) p q)) 
  = ring_add r
      (coeff d (ring_mul(x_ring r) (x_derivative r p) q))
      (coeff d (ring_mul(x_ring r) p (x_derivative r q)))
`,
  rw[x_ring_mul] THEN
  simp[coeff_x_derivative_poly_mul]
);;

let coeff_x_derivative_mul2 = prove(`
  !(r:R ring) p q d.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  coeff d (x_derivative r (ring_mul(x_ring r) p q))
  = coeff d (ring_add(x_ring r)
               (ring_mul(x_ring r) (x_derivative r p) q)
               (ring_mul(x_ring r) p (x_derivative r q)))
`,
  simp[coeff_x_derivative_mul;coeff_add]
);;

let x_derivative_mul = prove(`
  !(r:R ring) p q.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_mul(x_ring r) p q)
  = ring_add(x_ring r)
      (ring_mul(x_ring r) (x_derivative r p) q)
      (ring_mul(x_ring r) p (x_derivative r q))
`,
  intro THEN
  have `ring_mul(x_ring r) p q IN ring_carrier(x_ring(r:R ring))` [RING_MUL] THEN
  have `x_derivative r (ring_mul(x_ring r) p q) IN ring_carrier(x_ring(r:R ring))` [x_derivative_in_x_ring] THEN
  have `x_derivative r p IN ring_carrier(x_ring(r:R ring))` [x_derivative_in_x_ring] THEN
  have `x_derivative r q IN ring_carrier(x_ring(r:R ring))` [x_derivative_in_x_ring] THEN
  have `ring_mul(x_ring r) (x_derivative r p) q IN ring_carrier(x_ring(r:R ring))` [RING_MUL] THEN
  have `ring_mul(x_ring r) p (x_derivative r q) IN ring_carrier(x_ring(r:R ring))` [RING_MUL] THEN
  have `ring_add(x_ring r) (ring_mul(x_ring r) (x_derivative r p) q) (ring_mul(x_ring r) p (x_derivative r q)) IN ring_carrier(x_ring(r:R ring))` [RING_ADD] THEN
  qed[coeff_x_derivative_mul2;eq_if_coeff_eq]
);;

let x_derivative_mul_const = prove(`
  !(r:R ring) c q.
  c IN ring_carrier r ==>
  q IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_mul(x_ring r) (poly_const r c) q)
  = ring_mul(x_ring r) (poly_const r c) (x_derivative r q)
`,
  simp[x_derivative_mul;poly_const_in_x_ring] THEN
  simp[x_derivative_poly_const] THEN
  simp[GSYM x_ring_0;ring_0_mul] THEN
  simp[ring_0_add;RING_MUL;poly_const_in_x_ring;x_derivative_in_x_ring]
);;

let x_derivative_poly_x = prove(`
  !r:R ring.
  x_derivative r (poly_x r) = poly_1 r
`,
  intro THEN
  rw[poly_x;x_derivative_x_pow;RING_OF_NUM_1;ARITH_RULE `1 - 1 = 0`;const_x_pow;x_pow_0;poly_1] THEN
  simp[GSYM POLY_CONST_MUL;ring_mul_1;RING_1]
);;

let x_derivative_x_minus_const = prove(`
  !(r:R ring) c.
  c IN ring_carrier r ==>
  x_derivative r (x_minus_const r c) = poly_1 r
`,
  intro THEN
  rw[x_minus_const] THEN
  simp[x_derivative_sub;x_in_x_ring;poly_const_in_x_ring;x_derivative_poly_x;x_derivative_poly_const] THEN
  rw[GSYM x_ring_1;GSYM x_ring_0] THEN
  simp[RING_SUB_RZERO;RING_1]
);;

let x_derivative_x_plus_const = prove(`
  !(r:R ring) c.
  c IN ring_carrier r ==>
  x_derivative r (x_plus_const r c) = poly_1 r
`,
  intro THEN
  rw[x_plus_const] THEN
  rw[GSYM x_ring_add] THEN
  simp[x_derivative_add;x_in_x_ring;poly_const_in_x_ring;x_derivative_poly_x;x_derivative_poly_const] THEN
  rw[GSYM x_ring_1;GSYM x_ring_0] THEN
  simp[RING_ADD_RZERO;RING_1]
);;

let x_derivative_bernoulli_rule = prove(`
  !(r:R ring) p q c.
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  c IN ring_carrier r ==>
  poly_eval r c p = ring_0 r ==>
  poly_eval r c (x_derivative r (ring_mul(x_ring r) p q))
  = ring_mul r (poly_eval r c (x_derivative r p)) (poly_eval r c q)
`,
  intro THEN
  simp[x_derivative_mul] THEN
  have `x_derivative r q IN ring_carrier(x_ring(r:R ring))` [x_derivative_in_x_ring] THEN
  have `x_derivative r p IN ring_carrier(x_ring(r:R ring))` [x_derivative_in_x_ring] THEN
  have `ring_mul(x_ring r) (x_derivative r p) q IN ring_carrier(x_ring(r:R ring))` [RING_MUL] THEN
  have `ring_mul(x_ring r) p (x_derivative r q) IN ring_carrier(x_ring(r:R ring))` [RING_MUL] THEN
  have `poly_eval r c (x_derivative r q) IN ring_carrier(r:R ring)` [poly_eval_in_ring] THEN
  have `poly_eval r c (x_derivative r p) IN ring_carrier(r:R ring)` [poly_eval_in_ring] THEN
  have `poly_eval r c q IN ring_carrier(r:R ring)` [poly_eval_in_ring] THEN
  have `ring_mul r (poly_eval r c (x_derivative r p)) (poly_eval r c q) IN ring_carrier(r:R ring)` [RING_MUL] THEN
  simp[poly_eval_add;poly_eval_mul;ring_0_mul;ring_add_0]
);;

let x_derivative_product = prove(`
  !(r:R ring) f (S:X->bool).
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  x_derivative r (ring_product(x_ring r) S f)
  = ring_sum(x_ring r) S
      (\s. ring_mul(x_ring r)
             (x_derivative r (f s))
             (ring_product(x_ring r) (S DELETE s) f))
`,
  GEN_TAC THEN GEN_TAC THEN
  sufficesby FINITE_INDUCT_STRONG THEN
  intro THENL [
    simp[RING_PRODUCT_CLAUSES;RING_SUM_CLAUSES] THEN
    qed[x_derivative_1;x_ring_0;x_ring_1]
  ;
    have `(x:X) IN x INSERT S` [IN_INSERT] THEN
    have `f (x:X) IN ring_carrier(x_ring(r:R ring))` [] THEN
    have `ring_mul (x_ring(r:R ring)) (x_derivative r (f (x:X))) (ring_product (x_ring r) ((x INSERT S) DELETE x) f) IN ring_carrier (x_ring r)` [RING_MUL;RING_PRODUCT;x_derivative_in_x_ring] THEN
    simp[RING_PRODUCT_CLAUSES;RING_SUM_CLAUSES] THEN
    set_tac `~(x IN S) ==> ((x:X) INSERT S) DELETE x = S` [] THEN
    simp[] THEN
    set_tac `!s:X. s IN S ==> ~(x IN S) ==> (x INSERT S) DELETE s = x INSERT (S DELETE s)` [] THEN
    have `!s:X. s IN S ==> f s IN ring_carrier(x_ring(r:R ring))` [IN_INSERT] THEN
    have `!s:X. FINITE(S DELETE s)` [FINITE_DELETE] THEN
    set_tac `!s:X. s IN S ==> ~(x IN S) ==> ~(x IN S DELETE s)` [] THEN
    simp[RING_PRODUCT_CLAUSES;x_derivative_mul;RING_PRODUCT] THEN
    have `!s:X. s IN S ==> ring_mul (x_ring(r:R ring)) (x_derivative r (f s)) (ring_mul (x_ring r) (f x) (ring_product (x_ring r) (S DELETE s) f)) = ring_mul (x_ring r) (f x) (ring_mul (x_ring r) (x_derivative r (f s)) (ring_product (x_ring r) (S DELETE s) f))` [x_derivative_in_x_ring;RING_PRODUCT;RING_RULE `ring_mul(r:R ring) D (ring_mul r f P) = ring_mul r f (ring_mul r D P)`] THEN
    have `ring_sum (x_ring(r:R ring)) S (\s:X. ring_mul (x_ring r) (x_derivative r (f s)) (ring_mul (x_ring r) (f x) (ring_product (x_ring r) (S DELETE s) f))) = ring_sum (x_ring r) S (\s. ring_mul (x_ring r) (f x) (ring_mul (x_ring r) (x_derivative r (f s)) (ring_product (x_ring r) (S DELETE s) f))) ` [RING_SUM_EQ] THEN
    simp[] THEN
    specialize_raw[`x_ring(r:R ring)`;`\s:X. ring_mul (x_ring(r:R ring)) (x_derivative r (f s)) (ring_product (x_ring r) (S DELETE s) f)`;`f (x:X):(num->num)->R`;`S:X->bool`]RING_SUM_LMUL THEN
    qed[RING_PRODUCT;RING_MUL;x_derivative_in_x_ring]
  ]
);;

(* should do chain rule more generally *)
let x_derivative_pow = prove(`
  !(r:R ring) p n.
  p IN ring_carrier(x_ring r) ==>
  x_derivative r (ring_pow(x_ring r) p n)
  = ring_mul(x_ring r)
      (ring_of_num(x_ring r) n)
      (ring_mul(x_ring r)
         (ring_pow(x_ring r) p (n-1))
         (x_derivative r p))
`,
  GEN_TAC THEN GEN_TAC THEN
  INDUCT_TAC THENL [
    rw[RING_POW_0;RING_OF_NUM_0;x_ring_1;x_derivative_1] THEN
    simp[ring_0_mul;RING_MUL;RING_POW;x_derivative_in_x_ring;x_ring_0]
  ;
    intro THEN
    rw[ring_pow] THEN
    simp[x_derivative_mul;RING_POW;ring_of_num;ARITH_RULE `SUC n - 1 = n`] THEN
    ASM_CASES_TAC `n = 0` THENL [
      simp[RING_POW_0;RING_OF_NUM_0] THEN
      simp[ring_0_mul;ring_mul_1;ring_1_mul;ring_mul_0;ring_0_add;ring_add_0;RING_MUL;RING_POW;x_derivative_in_x_ring;RING_1]
    ; pass
    ] THEN
    num_linear `~(n = 0) ==> n = SUC(n-1)` THEN
    have `ring_pow(x_ring(r:R ring)) p n = ring_mul(x_ring r) p (ring_pow(x_ring r) p (n-1))` [ring_pow] THEN
    qed [RING_POW;RING_1;x_derivative_in_x_ring;RING_OF_NUM;RING_RULE `N = ring_mul(r:R ring) p M ==> ring_add r (ring_mul r D N) (ring_mul r p (ring_mul r i (ring_mul r M D))) = ring_mul r (ring_add r i (ring_1 r)) (ring_mul r N D)`]
  ]
);;

(* ----- monic_vanishing_at derivative *)

(* could use this in eval_derivative_monic_vanishing_at *)
let derivative_monic_vanishing_at = prove(`
  !(r:R ring) S.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  x_derivative r (monic_vanishing_at r S)
  = ring_sum(x_ring r) S (\s. monic_vanishing_at_except r S s)
`,
  intro THEN
  rw[monic_vanishing_at_except;monic_vanishing_at] THEN
  have `!s:R. s IN S ==> s IN ring_carrier r` [SUBSET] THEN
  have `!s:R. s IN S ==> x_minus_const r s IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  simp[x_derivative_product;x_derivative_x_minus_const] THEN
  rw[GSYM x_ring_1] THEN
  simp[ring_1_mul;RING_PRODUCT]
);;

let eval_derivative_monic_vanishing_at = prove(`
  !(r:R ring) S s.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  s IN S ==>
  poly_eval r s (x_derivative r (monic_vanishing_at r S))
  = poly_eval r s (monic_vanishing_at_except r S s)
`,
  intro THEN
  have `monic_vanishing_at(r:R ring) S = ring_mul(x_ring r) (x_minus_const r s) (monic_vanishing_at_except r S s)` [missing_times_monic_vanishing_at_except] THEN
  have `s IN ring_carrier(r:R ring)` [SUBSET] THEN
  have `poly_eval(r:R ring) s (x_minus_const r s) = ring_0 r` [eval_x_minus_const;RING_SUB_REFL] THEN
  have `x_minus_const r s IN ring_carrier(x_ring(r:R ring))` [x_minus_const_in_x_ring] THEN
  have `monic_vanishing_at_except r S s IN ring_carrier(x_ring(r:R ring))` [monic_vanishing_at_except_in_x_ring] THEN
  specialize[`r:R ring`;`x_minus_const (r:R ring) s`;`monic_vanishing_at_except(r:R ring) S s`;`s:R`]x_derivative_bernoulli_rule THEN
  have `poly_eval r s (monic_vanishing_at_except r S s) IN ring_carrier(r:R ring)` [poly_eval_in_ring] THEN
  simp[x_derivative_x_minus_const;poly_eval_1;ring_1_mul]
);;

(* ----- decoding binary Goppa codes *)

let goppa_decoding_lemma1 = prove(`
  !(k:K ring) B G Aprime e.
  field k ==>
  B IN ring_carrier k ==>
  G IN ring_carrier k ==>
  Aprime IN ring_carrier k ==>
  e IN ring_carrier k ==>
  ~(Aprime = ring_0 k) ==>
  ring_mul k (ring_sub k (ring_div k (ring_mul k G B) Aprime) e) Aprime
  = ring_sub k (ring_mul k G B) (ring_mul k e Aprime)
`,
  FIELD_TAC
);;

let goppa_decoding_lemma2 = prove(`
  !(k:K ring) S A B a b f Aprime aprime Aa (e:K->K) s.
  integral_domain k ==>
  S SUBSET ring_carrier k ==>
  A IN ring_carrier(x_ring k) ==>
  Aprime = x_derivative k A ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  aprime = x_derivative k a ==>
  b IN ring_carrier(x_ring k) ==>
  f IN ring_carrier(x_ring k) ==>
  Aa IN ring_carrier(x_ring k) ==>
  A = ring_mul(x_ring k) a Aa ==>
  ring_sub(x_ring k) B f = ring_mul(x_ring k) b Aa ==>
  s IN S ==>
  ring_mul k (e s) (poly_eval k s Aprime)
  = ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f)) ==>
  poly_eval k s a = ring_0 k ==>
  e s = ring_1 k ==>
  ~(poly_eval k s Aprime = ring_0 k) ==>
  poly_eval k s aprime
  = ring_mul k (poly_eval k s G) (poly_eval k s b)
`,
  intro THEN
  have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
  have `Aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
  have `aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
  have `poly_eval k s Aprime IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k s aprime IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k s Aa IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k s G IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `poly_eval k s b IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `ring_mul k (poly_eval k s G) (poly_eval k s b) IN ring_carrier(k:K ring)` [RING_MUL] THEN
  have `poly_eval (k:K ring) s Aprime = ring_mul k (e s) (poly_eval k s Aprime)` [ring_1_mul] THEN
  have `poly_eval (k:K ring) s Aprime = ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f))` [] THEN
  have `poly_eval (k:K ring) s (ring_sub(x_ring k) B f) = ring_sub k (poly_eval k s B) (poly_eval k s f)` [poly_eval_sub] THEN
  have `poly_eval (k:K ring) s (ring_mul(x_ring k) b Aa) = ring_mul k (poly_eval k s b) (poly_eval k s Aa)` [poly_eval_mul] THEN
  have `ring_sub (k:K ring) (poly_eval k s B) (poly_eval k s f) = ring_mul k (poly_eval k s b) (poly_eval k s Aa)` [] THEN
  have `poly_eval (k:K ring) s Aprime = ring_mul k (poly_eval k s G) (ring_mul k (poly_eval k s b) (poly_eval k s Aa))` [] THEN
  have `poly_eval (k:K ring) s Aprime = ring_mul k (ring_mul k (poly_eval k s G) (poly_eval k s b)) (poly_eval k s Aa)` [RING_MUL_ASSOC] THEN
  have `poly_eval (k:K ring) s Aprime = ring_mul k (poly_eval k s aprime) (poly_eval k s Aa)` [x_derivative_bernoulli_rule] THEN
  have `~(poly_eval k s Aa = ring_0 (k:K ring))` [ring_mul_0] THEN
  qed[INTEGRAL_DOMAIN_MUL_RCANCEL]
);;

let goppa_decoding_lemma3 = prove(`
  !(k:K ring) S A B a b f aBbA Aprime aprime (e:K->K) s.
  integral_domain k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  f IN ring_carrier(x_ring k) ==>
  ring_divides(x_ring k) a A ==>
  Aprime = x_derivative k A ==>
  aprime = x_derivative k a ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  ring_mul(x_ring k) a f = aBbA ==>
  s IN S ==>
  ring_mul k (e s) (poly_eval k s Aprime)
  = ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f)) ==>
  poly_eval k s a = ring_0 k ==>
  e s = ring_1 k ==>
  poly_eval k s aprime
  = ring_mul k (poly_eval k s G) (poly_eval k s b)
`,
  intro THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `~(A = ring_0(x_ring(k:K ring)))` [monic_vanishing_at_nonzero;x_ring_0] THEN
  have `~(a = ring_0(x_ring(k:K ring)))` [ring_nonzero_if_divides_nonzero] THEN
  have `~(poly_eval k s Aprime = ring_0(k:K ring))` [eval_derivative_monic_vanishing_at;eval_monic_vanishing_at_except_nonzero] THEN
  choose `Aa:(num->num)->K` `Aa IN ring_carrier(x_ring(k:K ring)) /\ A = ring_mul(x_ring k) a Aa` [ring_divides] THEN
  have `ring_mul(x_ring(k:K ring)) a (ring_sub(x_ring k) B f) = ring_mul(x_ring k) a (ring_mul(x_ring k) b Aa)` [RING_RULE `ring_mul(r:R ring) a f = ring_sub r (ring_mul r a B) (ring_mul r b A) ==> A = ring_mul r a Aa ==> ring_mul r a (ring_sub r B f) = ring_mul r a (ring_mul r b Aa)`] THEN
  have `ring_sub(x_ring k) B f IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring k) b Aa IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `integral_domain(x_ring(k:K ring))` [x_ring_domain] THEN
  have `ring_sub(x_ring(k:K ring)) B f = ring_mul(x_ring k) b Aa` [INTEGRAL_DOMAIN_MUL_LCANCEL] THEN
  have `Aa IN ring_carrier(x_ring(k:K ring))` [] THEN
  have `A = ring_mul(x_ring(k:K ring)) a Aa` [] THEN
  specialize[`k:K ring`;`S:K->bool`;`A:(num->num)->K`;`B:(num->num)->K`;`a:(num->num)->K`;`b:(num->num)->K`;`f:(num->num)->K`;`Aprime:(num->num)->K`;`aprime:(num->num)->K`;`Aa:(num->num)->K`;`e:K->K`;`s:K`]goppa_decoding_lemma2 THEN
  qed[]
);;

let goppa_decoding = prove(`
  !(k:K ring) S G A B t a b Aprime aprime aBbA e.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  G IN ring_carrier(x_ring k) ==>
  twodeg k G = 2 EXP (2*t) ==>
  ring_coprime(x_ring k) (G,A) ==>
  approximant k A B t a b ==>
  (!s. s IN S ==> (e s = ring_0 k \/ e s = ring_1 k)) ==>
  hamming_weight k e S <= t ==>
  Aprime = x_derivative k A ==>
  aprime = x_derivative k a ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  ring_divides(x_ring k) G (
    ring_sum(x_ring k) S
      (\s. ring_mul(x_ring k)
             (poly_const k (
                ring_sub k
                  (ring_div k
                     (ring_mul k
                        (poly_eval k s G)
                        (poly_eval k s B))
                     (poly_eval k s Aprime))
                  (e s)))
             (monic_vanishing_at_except k S s))) ==>
  (   (!s. s IN S ==>
       (e s = ring_1 k <=> poly_eval k s a = ring_0 k))
   /\ 2 EXP (hamming_weight k e S) = twodeg k a
   /\ ring_divides(x_ring k) a A
   /\ ring_divides(x_ring k) a
        (ring_sub(x_ring k) (ring_mul(x_ring k) G b) aprime)
   /\ 2 EXP (2*t) * twodeg k aBbA < twodeg k A * twodeg k a
  )
`,
  intro_genonly THEN
  REPEAT DISCH_TAC THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  def `c:K->K` `\s:K. ring_sub k (ring_div k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime)) (e s)` THEN
  have `!s:K. s IN S ==> s IN ring_carrier(k:K ring)` [SUBSET] THEN
  have `!s:K. s IN S ==> poly_eval k s G IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> poly_eval k s B IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> poly_eval k s Aprime IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> ring_mul k (poly_eval k s G) (poly_eval k s B) IN ring_carrier(k:K ring)` [RING_MUL] THEN
  have `!s:K. s IN S ==> ring_div k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime) IN ring_carrier(k:K ring)` [RING_DIV] THEN
  have `!s:K. e s = ring_0 k ==> e s IN ring_carrier(k:K ring)` [RING_0] THEN
  have `!s:K. e s = ring_1 k ==> e s IN ring_carrier(k:K ring)` [RING_1] THEN
  have `!s:K. s IN S ==> e s IN ring_carrier(k:K ring)` [] THEN
  have `!s:K. s IN S ==> c s IN ring_carrier(k:K ring)` [RING_SUB] THEN
  have `!s:K. s IN S ==> poly_const k (c s) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
  have `ring_divides(x_ring(k:K ring)) G (ring_sum(x_ring k) S (\s. ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)))` [RING_SUM_EQ] THEN
  choose `f:(num->num)->K` `f IN ring_carrier(x_ring k) /\ ring_mul(x_ring(k:K ring)) G f = ring_sum(x_ring k) S (\s. ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s))` [ring_divides] THEN
  have `!s:K. s IN S ==> poly_eval k s f IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> monic_vanishing_at_except(k:K ring) S s IN ring_carrier(x_ring k)` [monic_vanishing_at_except_in_x_ring] THEN
  subgoal `2 EXP (2*t) * twodeg(k:K ring) f < twodeg k A` THENL [
    have `twodeg(k:K ring) A = 2 EXP CARD(S:K->bool)` [twodeg_monic_vanishing_at] THEN
    have `!s:K. s IN S ==> twodeg k (monic_vanishing_at_except(k:K ring) S s) < 2 EXP CARD S` [twodeg_monic_vanishing_at_except_lt] THEN
    have `!s:K. s IN S ==> c s = ring_0 k ==> twodeg(k:K ring) (poly_const k (c s)) <= 1` [twodeg_poly_const;ARITH_RULE `0 <= 1`] THEN
    have `!s:K. s IN S ==> ~(c s = ring_0 k) ==> twodeg(k:K ring) (poly_const k (c s)) <= 1` [twodeg_poly_const;ARITH_RULE `2 EXP 0 <= 1`] THEN
    have `!s:K. s IN S ==> twodeg(k:K ring) (poly_const k (c s)) <= 1` [] THEN
    have `!s:K. s IN S ==> twodeg(k:K ring) (ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)) = twodeg k (poly_const k (c s)) * twodeg k (monic_vanishing_at_except k S s)` [twodeg_mul] THEN
    have `!s:K. s IN S ==> twodeg k (poly_const k (c s)) * twodeg k (monic_vanishing_at_except k S s) <= twodeg k (monic_vanishing_at_except k S s)` [LE_MULT2;LE_REFL;ARITH_RULE `1 * t = t`] THEN
    have `!s:K. s IN S ==> twodeg k (poly_const k (c s)) * twodeg k (monic_vanishing_at_except k S s) < 2 EXP CARD S` [LET_TRANS] THEN
    have `!s:K. s IN S ==> twodeg k (ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)) < 2 EXP CARD S` [] THEN
    specialize[`k:K ring`;`S:K->bool`;`(\s:K. ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s))`;`CARD(S:K->bool)`]twodeg_sum_lt THEN
    have `twodeg(k:K ring) (ring_sum(x_ring k) S (\s. ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s))) < 2 EXP CARD S` [] THEN
    have `twodeg(k:K ring) (ring_mul(x_ring k) G f) < twodeg k A` [] THEN
    have `twodeg(k:K ring) (ring_mul(x_ring k) G f) = 2 EXP (2*t) * twodeg k f` [twodeg_mul] THEN
    qed[]
  ; pass
  ]
  THEN
  have `!t:K. t IN S ==> poly_eval k t (ring_sum(x_ring k) S (\s. ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s))) = ring_mul k (c t) (poly_eval k t (monic_vanishing_at_except k S t))` [eval_sum_monic_vanishing_at_except] THEN
  have `!s:K. s IN S ==> poly_eval k s (ring_mul(x_ring k) G f) = ring_mul k (c s) (poly_eval k s Aprime)` [eval_derivative_monic_vanishing_at] THEN
  have `!s:K. s IN S ==> poly_eval k s Aprime = poly_eval k s (monic_vanishing_at_except k S s)` [eval_derivative_monic_vanishing_at] THEN
  have `!s:K. s IN S ==> ~(poly_eval k s (monic_vanishing_at_except k S s) = ring_0 k)` [eval_monic_vanishing_at_except_nonzero] THEN
  have `!s:K. s IN S ==> ~(poly_eval k s Aprime = ring_0 k)` [] THEN
  ASSUME_TAC(GEN `s:K` (ISPECL[`k:K ring`;`poly_eval(k:K ring) s B`;`poly_eval(k:K ring) s G`;`poly_eval(k:K ring) s Aprime`;`(e:K->K) s`]goppa_decoding_lemma1)) THEN
  have `!s:K. s IN S ==> ring_mul k (c s) (poly_eval k s Aprime) = ring_sub k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (ring_mul k (e s) (poly_eval k s Aprime))` [] THEN
  have `!s:K. s IN S ==> ring_mul k (poly_eval k s G) (poly_eval k s f) = ring_sub k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (ring_mul k (e s) (poly_eval k s Aprime))` [poly_eval_mul] THEN
  have `!s:K. s IN S ==> ring_mul k (e s) (poly_eval k s Aprime) = ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f))` [RING_RULE `ring_mul(k:K ring) (poly_eval k s G) (poly_eval k s f) = ring_sub k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (ring_mul k (e s) (poly_eval k s Aprime)) ==> ring_mul k (e s) (poly_eval k s Aprime) = ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f))`] THEN
  have `!s:K. s IN S ==> poly_eval k s A = ring_0 k` [monic_vanishing_at_vanishes] THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  have `!s:K. s IN S ==> ~(poly_eval k s G = ring_0 k)` [not_coprime_if_shared_root] THEN
  have `!s:K. s IN S ==> ring_sub k (poly_eval k s B) (poly_eval k s f) IN ring_carrier k` [RING_SUB] THEN
  have `!s:K. s IN S ==> e s = ring_0 k ==> ring_mul k (e s) (poly_eval k s Aprime) = ring_0 k` [ring_0_mul] THEN
  have `!s:K. s IN S ==> ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f)) = ring_0 k ==> ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k` [integral_domain] THEN
  have `!s:K. s IN S ==> e s = ring_0 k ==> ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k` [] THEN
  have `!s:K. s IN S ==> ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k ==> ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f)) = ring_0 k` [ring_mul_0] THEN
  have `!s:K. s IN S ==> ring_mul k (e s) (poly_eval k s Aprime) = ring_0 k ==> e s = ring_0 k` [integral_domain] THEN
  have `!s:K. s IN S ==> ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k ==> e s = ring_0 k` [] THEN
  have `f IN ring_carrier(x_ring(k:K ring))` [] THEN
  def `E:K->K` `\s:K. ring_sub k (poly_eval k s B) (poly_eval k s f)` THEN
  have `!s:K. s IN S ==> E s = ring_sub k (poly_eval k s B) (poly_eval k s f)` [] THEN
  subgoal `hamming_weight (k:K ring) E (S:K->bool) <= t` THENL [
    set_tac `(!s:K. s IN S ==> (e s = ring_0 k <=> ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)) ==> {s | s IN S /\ ~(e s = ring_0 k)} = {s | s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)}` [] THEN
    have `{s:K | s IN S /\ ~(e s = ring_0 k)} = {s:K | s IN S /\ ~(ring_sub k (poly_eval k s B) (poly_eval k s f) = ring_0 k)}` [] THEN
    specialize[`S:K->bool`;`e:K->K`;`k:K ring`]hamming_weight THEN
    specialize[`S:K->bool`;`\s:K. ring_sub k (poly_eval k s B) (poly_eval k s f)`;`k:K ring`]hamming_weight THEN
    have `hamming_weight k e S = hamming_weight k (\s:K. ring_sub k (poly_eval k s B) (poly_eval k s f)) S` [] THEN
    qed[]
  ; pass
  ]
  THEN
  specialize[`k:K ring`;`S:K->bool`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`;`a:(num->num)->K`;`b:(num->num)->K`;`f:(num->num)->K`;`E:K->K`;`aBbA:(num->num)->K`]interpolation_with_errors THEN
  set_tac `{s:K | s IN S /\ ~(E s = ring_0 k)} = {s | s IN S /\ poly_eval k s a = ring_0 k} ==> !s. s IN S ==> (~(E s = ring_0 k) <=> poly_eval k s a = ring_0 k)` [] THEN
  have `!s:K. s IN S ==> (~(E s = ring_0 k) <=> poly_eval k s a = ring_0 k)` [] THEN
  have `!s:K. s IN S ==> (~(e s = ring_0 k) <=> poly_eval k s a = ring_0 k)` [] THEN
  have `!s:K. s IN S ==> (e s = ring_1(k:K ring) <=> ~(e s = ring_0 k))` [integral_domain] THEN
  have `!s:K. s IN S ==> (e s = ring_1 k <=> poly_eval k s a = ring_0 k)` [] THEN
  have `b IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  subgoal `!s:K. s IN S ==> poly_eval k s a = ring_0 k ==> poly_eval k s aprime = ring_mul k (poly_eval k s G) (poly_eval k s b)` THENL [
    intro THEN
    have `B IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
    have `a IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
    have `ring_divides(x_ring(k:K ring)) a A` [] THEN
    have `ring_mul(x_ring(k:K ring)) a f = aBbA` [] THEN
    have `ring_mul(k:K ring) (e s) (poly_eval k s Aprime) = ring_mul k (poly_eval k s G) (ring_sub k (poly_eval k s B) (poly_eval k s f))` [] THEN
    have `(e:K->K) s = ring_1 k` [] THEN
    specialize[`k:K ring`;`S:K->bool`;`A:(num->num)->K`;`B:(num->num)->K`;`a:(num->num)->K`;`b:(num->num)->K`;`f:(num->num)->K`;`aBbA:(num->num)->K`;`Aprime:(num->num)->K`;`aprime:(num->num)->K`;`e:K->K`;`s:K`]goppa_decoding_lemma3 THEN
    qed[]
  ; pass
  ] THEN
  have `ring_mul (x_ring k) G b IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `a IN ring_carrier(x_ring(k:K ring))` [approximant] THEN
  have `aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
  have `ring_sub (x_ring k) (ring_mul(x_ring k) G b) aprime IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  subgoal `!s:K. s IN S ==> poly_eval k s a = ring_0 k ==> poly_eval k s (ring_sub (x_ring k) (ring_mul (x_ring k) G b) aprime) = ring_0 k` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `poly_eval k s b IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
    have `ring_mul k (poly_eval k s G) (poly_eval k s b) IN ring_carrier(k:K ring)` [RING_MUL] THEN
    simp[poly_eval_sub;poly_eval_mul;RING_SUB_REFL]
  ; pass
  ] THEN
  have `ring_divides(x_ring(k:K ring)) a A` [] THEN
  specialize[`k:K ring`;`S:K->bool`;`A:(num->num)->K`;`a:(num->num)->K`;`ring_sub (x_ring k) (ring_mul (x_ring k) G b) aprime:(num->num)->K`]divides_if_roots_and_divides_monic_vanishing_at THEN
  have `ring_divides(x_ring(k:K ring)) a (ring_sub (x_ring k) (ring_mul (x_ring k) G b) aprime)` [] THEN
  subgoal `2 EXP hamming_weight(k:K ring) (e:K->K) S = twodeg k a` THENL [
    have `twodeg k a = 2 EXP CARD {s:K | s IN S /\ poly_eval k s a = ring_0 k}` [twodeg_if_divides_monic_vanishing_at] THEN
    subgoal `{s:K | s IN S /\ poly_eval k s a = ring_0 k} = {s:K | s IN S /\ ~(e s = ring_0 k)}` THENL [
      simp[EXTENSION;IN_ELIM_THM] THEN
      qed[]
    ; pass
    ] THEN
    have `hamming_weight (k:K ring) (e:K->K) S = CARD {s:K | s IN S /\ ~(e s = ring_0 k)}` [hamming_weight] THEN
    have `hamming_weight (k:K ring) (e:K->K) S = CARD {s:K | s IN S /\ poly_eval k s a = ring_0 k}` [] THEN
    have `2 EXP hamming_weight (k:K ring) (e:K->K) S = 2 EXP CARD {s:K | s IN S /\ poly_eval k s a = ring_0 k}` [] THEN
    qed[]
  ; pass
  ] THEN
  qed[]
);;

let goppa_checking_lemma = prove(`
  !(k:K ring) G B e Aprime.
  field k ==>
  G IN ring_carrier k ==>
  B IN ring_carrier k ==>
  e IN ring_carrier k ==>
  Aprime IN ring_carrier k ==>
  ~(Aprime = ring_0 k) ==>
  ring_sub k (ring_mul k G B) (ring_mul k e Aprime)
  = ring_mul k (ring_sub k (ring_div k (ring_mul k G B) Aprime) e) Aprime
`,
  FIELD_TAC
);;

let goppa_checking = prove(`
  !(k:K ring) S G A B t a b Aprime aprime aBbA e.
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  G IN ring_carrier(x_ring k) ==>
  A = monic_vanishing_at k S ==> 
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  twodeg k G = 2 EXP (2*t) ==>
  Aprime = x_derivative k A ==>
  aprime = x_derivative k a ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  ring_divides(x_ring k) a A ==>
  2 EXP (2*t) * twodeg k aBbA < twodeg k A * twodeg k a ==>
  ring_divides(x_ring k) a
    (ring_sub(x_ring k) (ring_mul(x_ring k) G b) aprime) ==>
  (!s. s IN S ==>
       e s = if poly_eval k s a = ring_0 k then ring_1 k
             else ring_0 k) ==>
  (   2 EXP hamming_weight k e S = twodeg k a
   /\ ring_divides(x_ring k) G (
        ring_sum(x_ring k) S
          (\s. ring_mul(x_ring k)
                 (poly_const k (
                    ring_sub k
                      (ring_div k
                         (poly_eval k s
                            (ring_mul(x_ring k) G B))
                         (poly_eval k s Aprime))
                      (e s)))
                 (monic_vanishing_at_except k S s))))
`,
  REPEAT GEN_TAC THEN
  REPEAT DISCH_TAC THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
  have `twodeg(k:K ring) A = 2 EXP CARD(S:K->bool)` [twodeg_monic_vanishing_at] THEN
  have `~(A:(num->num)->K = poly_0(k:K ring))` [monic_vanishing_at_nonzero] THEN
  have `~(a:(num->num)->K = poly_0(k:K ring))` [x_ring_0;ring_nonzero_if_divides_nonzero] THEN
  choose `Aa:(num->num)->K` `Aa IN ring_carrier(x_ring(k:K ring)) /\ A = ring_mul(x_ring k) a Aa` [ring_divides] THEN
  def `f:(num->num)->K` `ring_sub(x_ring(k:K ring)) B (ring_mul(x_ring k) b Aa)` THEN
  have `ring_mul(x_ring k) b Aa IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `f IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  subgoal `twodeg(k:K ring) (ring_mul(x_ring k) G f) < 2 EXP CARD(S:K->bool)` THENL [
    have `ring_mul(x_ring(k:K ring)) a f = aBbA` [RING_RULE `A = ring_mul(r:R ring) a Aa ==> f = ring_sub r B (ring_mul r b Aa) ==> ring_mul r a f = ring_sub r (ring_mul r a B) (ring_mul r b A)`] THEN
    have `twodeg(k:K ring) a * twodeg k f = twodeg k aBbA` [twodeg_mul] THEN
    have `twodeg(k:K ring) a * (2 EXP (2*t) * twodeg k f) < twodeg k a * twodeg k A` [ARITH_RULE `t * (a * f) < A * a:num ==> a * (t * f) < a * A`] THEN
    have `2 EXP (2*t) * twodeg(k:K ring) f < twodeg k A` [LT_MULT_LCANCEL] THEN
    have `twodeg(k:K ring) (ring_mul(x_ring k) G f) = twodeg k G * twodeg k f` [twodeg_mul] THEN
    qed[]
  ; pass
  ] THEN
  subgoal `!s:K. s IN S ==> poly_eval(k:K ring) s (ring_mul(x_ring k) G f) = ring_mul k (ring_sub k (ring_div k (poly_eval k s (ring_mul(x_ring k) G B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s (monic_vanishing_at_except k S s))` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `poly_eval k s (ring_mul(x_ring(k:K ring)) G f) = ring_mul k (poly_eval k s G) (poly_eval k s f)` [poly_eval_mul] THEN
    have `poly_eval k s (ring_mul(x_ring(k:K ring)) G B) = ring_mul k (poly_eval k s G) (poly_eval k s B)` [poly_eval_mul] THEN
    have `poly_eval(k:K ring) s Aprime = poly_eval k s (monic_vanishing_at_except k S s)` [eval_derivative_monic_vanishing_at] THEN
    have `~(poly_eval(k:K ring) s (monic_vanishing_at_except k S s) = ring_0 k)` [eval_monic_vanishing_at_except_nonzero] THEN
    ASM_CASES_TAC `poly_eval(k:K ring) s a = ring_0 k` THENL [
      have `(e:K->K) s = ring_1 k` [] THEN
      have `(e:K->K) s IN ring_carrier k` [RING_1] THEN
      have `aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
      have `Aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
      have `ring_mul(x_ring k) b Aa IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
      have `ring_mul(x_ring k) G b IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
      have `ring_sub(x_ring k) (ring_mul(x_ring k) G b) aprime IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
      have `poly_eval(k:K ring) s (ring_sub (x_ring k) (ring_mul (x_ring k) G b) aprime) = ring_0 k` [root_if_divides_root] THEN
      have `poly_eval(k:K ring) s f IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s G IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s b IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s B IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s Aprime IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s Aa IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s aprime IN ring_carrier k` [poly_eval_in_ring] THEN
      have `ring_sub k (poly_eval(k:K ring) s (ring_mul(x_ring k) G b)) (poly_eval k s aprime) = ring_0 k` [poly_eval_sub] THEN
      have `ring_sub k (ring_mul k (poly_eval k s G) (poly_eval k s b)) (poly_eval k s aprime) = ring_0(k:K ring)` [poly_eval_mul] THEN
      have `poly_eval(k:K ring) s Aprime = ring_mul k (poly_eval k s aprime) (poly_eval k s Aa)` [x_derivative_bernoulli_rule] THEN
      have `poly_eval(k:K ring) s f = ring_sub k (poly_eval k s B) (poly_eval k s (ring_mul(x_ring k) b Aa))` [poly_eval_sub] THEN
      have `poly_eval(k:K ring) s f = ring_sub k (poly_eval k s B) (ring_mul k (poly_eval k s b) (poly_eval k s Aa))` [poly_eval_mul] THEN
      have `ring_sub(k:K ring) (ring_mul k (poly_eval k s G) (poly_eval k s B)) (ring_mul k (e s) (poly_eval k s Aprime)) = ring_mul k (poly_eval k s G) (poly_eval k s f)` [RING_RULE `Aprime = ring_mul(r:R ring) aprime Aa ==> ring_sub r (ring_mul r G b) aprime = ring_0 r ==> f = ring_sub r B (ring_mul r b Aa) ==> e = ring_1 r ==> ring_sub r (ring_mul r G B) (ring_mul r e Aprime) = ring_mul r G f`] THEN
      have `ring_sub(k:K ring) (ring_mul k (poly_eval k s G) (poly_eval k s B)) (ring_mul k (e s) (poly_eval k s Aprime)) = ring_mul k (ring_sub k (ring_div k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s Aprime)` [goppa_checking_lemma] THEN
      have `poly_eval(k:K ring) s (ring_mul (x_ring k) G f) = ring_mul k (ring_sub k (ring_div k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s Aprime)` [] THEN
      have `poly_eval(k:K ring) s (ring_mul (x_ring k) G f) = ring_mul k (ring_sub k (ring_div k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s (monic_vanishing_at_except k S s))` [] THEN
      have `ring_mul(k:K ring) (ring_sub k (ring_div k (poly_eval k s (ring_mul(x_ring k) G B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s (monic_vanishing_at_except k S s)) = ring_mul k (ring_sub k (ring_div k (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s (monic_vanishing_at_except k S s))` [] THEN
      qed[]
    ; have `(e:K->K) s = ring_0 k` [] THEN
      have `Aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
      have `poly_eval(k:K ring) s Aprime IN ring_carrier k` [poly_eval_in_ring] THEN
      have `ring_mul(x_ring k) G B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
      have `poly_eval k s (ring_mul(x_ring k) G B) IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
      have `poly_eval k s Aprime IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
      have `ring_div k (poly_eval k s (ring_mul(x_ring k) G B)) (poly_eval k s Aprime) IN ring_carrier(k:K ring)` [RING_DIV] THEN
      have `ring_sub(k:K ring) (ring_div k (poly_eval k s (ring_mul(x_ring k) G B)) (poly_eval k s Aprime)) (e s) = ring_div k (poly_eval k s (ring_mul(x_ring k) G B)) (poly_eval k s Aprime)` [RING_SUB_RZERO] THEN
      have `~(poly_eval k s Aprime = ring_0(k:K ring))` [] THEN
      specialize[`k:K ring`;`poly_eval(k:K ring) s (ring_mul(x_ring k) G B)`;`poly_eval(k:K ring) s Aprime`]field_div_mul_cancel THEN
      have `poly_eval(k:K ring) s A = ring_mul k (poly_eval k s a) (poly_eval k s Aa)` [poly_eval_mul] THEN
      have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
      have `poly_eval(k:K ring) s (monic_vanishing_at k S) = ring_0 k` [monic_vanishing_at_vanishes] THEN
      have `poly_eval(k:K ring) s A = ring_0 k` [] THEN
      have `poly_eval(k:K ring) s a IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s b IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s Aa IN ring_carrier k` [poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s Aa = ring_0 k` [integral_domain] THEN
      have `poly_eval(k:K ring) s (ring_mul(x_ring k) b Aa) = ring_mul k (poly_eval k s b) (poly_eval k s Aa)` [poly_eval_mul] THEN
      have `ring_mul(k:K ring) (poly_eval k s b) (ring_0 k) = ring_0 k` [ring_mul_0] THEN
      have `ring_mul(k:K ring) (poly_eval k s b) (poly_eval k s Aa) = ring_0 k` [] THEN
      have `poly_eval(k:K ring) s (ring_mul(x_ring k) b Aa) = ring_0 k` [] THEN
      have `ring_mul(x_ring k) b Aa IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
      have `poly_eval(k:K ring) s f = ring_sub k (poly_eval k s B) (poly_eval k s (ring_mul(x_ring k) b Aa))` [poly_eval_sub] THEN
      have `poly_eval(k:K ring) s B IN ring_carrier k` [poly_eval_in_ring] THEN
      have `ring_sub(k:K ring) (poly_eval k s B) (ring_0 k) = poly_eval k s B` [RING_SUB_RZERO] THEN
      have `ring_sub(k:K ring) (poly_eval k s B) (poly_eval k s (ring_mul(x_ring k) b Aa)) = poly_eval k s B` [] THEN
      have `poly_eval(k:K ring) s f = poly_eval k s B` [] THEN
      have `poly_eval(k:K ring) s (ring_mul(x_ring k) G f) = ring_mul k (poly_eval k s G) (poly_eval k s B)` [] THEN
      have `poly_eval(k:K ring) s (ring_mul(x_ring k) G f) = poly_eval k s (ring_mul(x_ring k) G B)` [] THEN
      have `ring_mul(k:K ring) (ring_div k (poly_eval k s (ring_mul (x_ring k) G B)) (poly_eval k s Aprime)) (poly_eval k s (monic_vanishing_at_except k S s)) = poly_eval k s (ring_mul(x_ring k) G B)` [] THEN
      have `ring_mul(k:K ring) (ring_sub k (ring_div k (poly_eval k s (ring_mul (x_ring k) G B)) (poly_eval k s Aprime)) (e s)) (poly_eval k s (monic_vanishing_at_except k S s)) = poly_eval k s (ring_mul(x_ring k) G B)` [] THEN
      qed[]
    ]
  ; pass
  ] THEN
  subgoal `!s:K. s IN S ==> ring_sub k (ring_div k (poly_eval k s (ring_mul (x_ring k) G B)) (poly_eval k s Aprime)) (e s) IN ring_carrier k` THENL [
    intro THEN
    have `(e:K->K) s IN ring_carrier(k:K ring)` [RING_0;RING_1] THEN
    qed[x_derivative_in_x_ring;poly_eval_in_ring;RING_MUL;RING_DIV;RING_SUB]
  ; pass
  ] THEN
  have `ring_mul(x_ring(k:K ring)) G f IN ring_carrier(x_ring k)` [RING_MUL] THEN
  specialize[`k:K ring`;`S:K->bool`;`ring_mul(x_ring(k:K ring)) G f`;`\s:K. ring_sub k (ring_div k (poly_eval k s (ring_mul (x_ring k) G B)) (poly_eval k s Aprime)) (e s)`]sum_monic_vanishing_at_except_unique THEN
  have `twodeg(k:K ring) a = 2 EXP CARD {s | s IN S /\ poly_eval k s a = ring_0 k}` [twodeg_if_divides_monic_vanishing_at] THEN
  subgoal `{s:K | s IN S /\ poly_eval k s a = ring_0 k} = {s:K | s IN S /\ ~(e s = ring_0 k)}` THENL [
    rw[EXTENSION;IN_ELIM_THM] THEN
    qed[integral_domain]
  ; pass
  ] THEN
  CONJ_TAC THENL [
    qed[hamming_weight]
  ;
    rw[ring_divides] THEN
    CONJ_TAC THENL [
      qed[]
    ;
      CONJ_TAC THENL [
        qed[RING_SUM]
      ;
        EXISTS_TAC `f:(num->num)->K` THEN
        qed[]
      ]
    ]
  ]
);;

(* ----- dimensions of goppa codes *)

let goppa_parity_lemma = prove(`
  !(k:K ring) S (v:K->K) m.
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  (!s. s IN S ==> v s IN ring_carrier k) ==>
  ring_sub(x_ring k)
    (ring_mul(x_ring k)
       (x_pow k m)
       (ring_sum(x_ring(k:K ring)) S (\s. ring_mul(x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s))))
    (ring_sum(x_ring(k:K ring)) S (\s. ring_mul(x_ring k) (poly_const k (ring_mul k (v s) (ring_pow k s m))) (monic_vanishing_at_except k S s)))
  = ring_mul(x_ring k)
      (monic_vanishing_at k S)
      (ring_sum(x_ring k) {d:num | d < m}
        (\d. const_x_pow k
               (ring_sum k S
                  (\s. ring_mul k (v s) (ring_pow k s (m-1-d))))
               d))
`,
  intro THEN
  subgoal `ring_mul (x_ring(k:K ring)) (x_pow k m) (ring_sum (x_ring k) S (\s. ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s))) = ring_sum (x_ring k) S (\s. ring_mul(x_ring k) (x_pow k m) (ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s)))` THENL [
    have `x_pow(k:K ring) m IN ring_carrier(x_ring k)` [x_pow_in_x_ring] THEN
    have `!s:K. s IN S ==> poly_const k (v s) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `!s:K. s IN S ==> monic_vanishing_at_except k S s IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_except_in_x_ring] THEN
    have `!s:K. s IN S ==> ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    specialize[`x_ring(k:K ring)`;`\s:K. ring_mul (x_ring k) (poly_const k ((v:K->K) s)) (monic_vanishing_at_except k S s)`;`x_pow(k:K ring) m`;`S:K->bool`]RING_SUM_LMUL THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `ring_sub (x_ring(k:K ring)) (ring_sum (x_ring k) S (\s. ring_mul (x_ring k) (x_pow k m) (ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s)))) (ring_sum (x_ring k) S (\s. ring_mul (x_ring k) (poly_const k (ring_mul k (v s) (ring_pow k s m))) (monic_vanishing_at_except k S s))) = ring_sum (x_ring k) S (\s.  ring_sub (x_ring k) (ring_mul (x_ring k) (x_pow k m) (ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s))) (ring_mul (x_ring k) (poly_const k (ring_mul k (v s) (ring_pow k s m))) (monic_vanishing_at_except k S s)))` THENL [
    have `x_pow(k:K ring) m IN ring_carrier(x_ring k)` [x_pow_in_x_ring] THEN
    have `!s:K. s IN S ==> poly_const k (v s) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `!s:K. s IN S ==> monic_vanishing_at_except k S s IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_except_in_x_ring] THEN
    have `!s:K. s IN S ==> ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    have `!s:K. s IN S ==> ring_mul (x_ring k) (x_pow k m) (ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s)) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    have `!s:K. s IN S ==> s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `!s:K. s IN S ==> ring_pow k s m IN ring_carrier(k:K ring)` [RING_POW] THEN
    have `!s:K. s IN S ==> ring_mul k (v s) (ring_pow k s m) IN ring_carrier(k:K ring)` [RING_MUL] THEN
    have `!s:K. s IN S ==> poly_const k (ring_mul k (v s) (ring_pow k s m)) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `!s:K. s IN S ==> ring_mul (x_ring k) (poly_const k ((ring_mul k (v s) (ring_pow k s m)))) (monic_vanishing_at_except k S s) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    have `!s:K. s IN S ==> ring_mul (x_ring k) (poly_const k (ring_mul k (v s) (ring_pow k s m))) (monic_vanishing_at_except k S s) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
    specialize[`x_ring(k:K ring)`;`\s. ring_mul (x_ring(k:K ring)) (x_pow k m) (ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s))`;`\s. ring_mul (x_ring(k:K ring)) (poly_const k (ring_mul k (v s) (ring_pow k s m))) (monic_vanishing_at_except k S s)`;`S:K->bool`]ring_sum_sub THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `!s:K. s IN S ==> poly_const(k:K ring) (ring_mul k (v s) (ring_pow k s m)) = ring_mul(x_ring k) (poly_const k (v s)) (poly_const k (ring_pow k s m))` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `(v:K->K) s IN ring_carrier(k:K ring)` [] THEN
    have `ring_pow k s m IN ring_carrier(k:K ring)` [RING_POW] THEN
    specialize[`k:K ring`;`(v:K->K) s`;`ring_pow k (s:K) m`]POLY_CONST_MUL THEN
    rw[x_ring_mul] THEN
    simp[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `!s:K. s IN S ==> ring_sub (x_ring(k:K ring)) (ring_mul (x_ring k) (x_pow k m) (ring_mul (x_ring k) (poly_const k (v s)) (monic_vanishing_at_except k S s))) (ring_mul (x_ring k) (ring_mul (x_ring k) (poly_const k (v s)) (poly_const k (ring_pow k s m))) (monic_vanishing_at_except k S s)) = ring_mul(x_ring k) (poly_const k (v s)) (ring_mul(x_ring k) (ring_sub(x_ring k) (x_pow k m) (poly_const k (ring_pow k s m))) (monic_vanishing_at_except k S s))` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `x_pow(k:K ring) m IN ring_carrier(x_ring k)` [x_pow_in_x_ring] THEN
    have `ring_pow k s m IN ring_carrier(k:K ring)` [RING_POW] THEN
    have `poly_const k ((v:K->K) s) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `poly_const k (ring_pow k s m) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `monic_vanishing_at_except k S s IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_except_in_x_ring] THEN
    specialize[`x_ring(k:K ring)`;`x_pow(k:K ring) m`;`poly_const(k:K ring) (ring_pow k s m):(num->num)->K`;`poly_const(k:K ring) ((v:K->K) s):(num->num)->K`;`monic_vanishing_at_except (k:K ring) S s`]ring_sub_mul_mul_mul_mul THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  have `!s:K. s IN S ==> ring_sub(x_ring(k:K ring)) (x_pow k m) (poly_const k (ring_pow k s m)) = ring_mul(x_ring k) (ring_sub(x_ring k) (poly_x k) (poly_const k s)) (ring_sum(x_ring k) {i | i < m} (\i. ring_mul(x_ring k) (x_pow k i) (ring_pow(x_ring k) (poly_const k s) (m-1-i))))` [geometric_series_x_const;SUBSET] THEN
  simp[] THEN
  simp[GSYM x_minus_const] THEN
  subgoal `!s:K. s IN S ==> ring_mul (x_ring(k:K ring)) (poly_const k (v s)) (ring_mul (x_ring k) (ring_mul (x_ring k) (x_minus_const k s) (ring_sum (x_ring k) {i | i < m} (\i. ring_mul (x_ring k) (x_pow k i) (ring_pow (x_ring k) (poly_const k s) (m - 1 - i))))) (monic_vanishing_at_except k S s)) = ring_mul(x_ring k) (monic_vanishing_at k S) (ring_mul(x_ring k) (poly_const k (v s)) (ring_sum (x_ring k) {i | i < m} (\i. ring_mul (x_ring k) (x_pow k i) (ring_pow (x_ring k) (poly_const k s) (m - 1 - i)))))` THENL [
    intro THEN
    specialize[`k:K ring`;`S:K->bool`;`s:K`]missing_times_monic_vanishing_at_except THEN
    simp[] THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `x_pow(k:K ring) m IN ring_carrier(x_ring k)` [x_pow_in_x_ring] THEN
    have `ring_pow k s m IN ring_carrier(k:K ring)` [RING_POW] THEN
    have `poly_const k ((v:K->K) s) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `x_minus_const(k:K ring) s IN ring_carrier(x_ring k)` [x_minus_const_in_x_ring] THEN
    have `poly_const k (ring_pow k s m) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    have `monic_vanishing_at_except k S s IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_except_in_x_ring] THEN
    have `ring_sum (x_ring k) {i | i < m} (\i. ring_mul (x_ring k) (x_pow k i) (ring_pow (x_ring k) (poly_const k s) (m - 1 - i))) IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
    qed[RING_RULE `ring_mul(r:R ring) V (ring_mul r (ring_mul r X S) M) = ring_mul r (ring_mul r X M) (ring_mul r V S)`]
  ; pass
  ] THEN
  simp[] THEN
  have `!s:K. !i. s IN S ==> ring_pow(x_ring(k:K ring)) (poly_const k s) (m-1-i) = poly_const k (ring_pow k s (m-1-i))` [poly_const_pow;SUBSET] THEN
  simp[] THEN
  subgoal `!s:K. s IN S ==> ring_mul (x_ring k) (poly_const k (v s)) (ring_sum (x_ring k) {i | i < m} (\i. ring_mul (x_ring k) (x_pow k i) (poly_const k (ring_pow k s (m - 1 - i))))) = ring_sum (x_ring k) {i | i < m} (\i. ring_mul (x_ring k) (poly_const k (v s)) (ring_mul (x_ring k) (x_pow k i) (poly_const k (ring_pow k s (m - 1 - i)))))` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `poly_const(k:K ring) (v (s:K)) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
    have `!i:num. i IN {i | i < m} ==> x_pow k i IN ring_carrier(x_ring(k:K ring))` [x_pow_in_x_ring] THEN
    have `!i:num. i IN {i | i < m} ==> poly_const k (ring_pow k s (m - 1 - i)) IN ring_carrier(x_ring(k:K ring))` [RING_POW;poly_const_in_x_ring] THEN
    have `!i:num. i IN {i | i < m} ==> ring_mul (x_ring(k:K ring)) (x_pow k i) (poly_const k (ring_pow k s (m - 1 - i))) IN ring_carrier(x_ring k)` [RING_MUL] THEN
    have `FINITE {i:num | i < m}` [FINITE_NUMSEG_LT] THEN
    specialize[`x_ring(k:K ring)`;`\i. ring_mul (x_ring(k:K ring)) (x_pow k i) (poly_const k (ring_pow k s (m - 1 - i)))`;`poly_const(k:K ring) (v (s:K)):(num->num)->K`;`{i:num | i < m}`]RING_SUM_LMUL THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `!s:K. s IN S ==> !i:num. ring_mul (x_ring(k:K ring)) (poly_const k (v s)) (ring_mul (x_ring k) (x_pow k i) (poly_const k (ring_pow k s (m - 1 - i)))) = const_x_pow k (ring_mul k (v s) (ring_pow k s (m-1-i))) i` THENL [
    intro THEN
    have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `(v:K->K) s IN ring_carrier(k:K ring)` [] THEN
    have `ring_pow(k:K ring) s (m-1-i) IN ring_carrier k` [RING_POW] THEN
    have `poly_const(k:K ring) (v (s:K)) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
    have `poly_const(k:K ring) (ring_pow(k:K ring) s (m-1-i)) IN ring_carrier(x_ring k)` [poly_const_in_x_ring] THEN
    have `x_pow(k:K ring) i IN ring_carrier(x_ring k)` [x_pow_in_x_ring] THEN
    simp[const_x_pow;POLY_CONST_MUL;GSYM x_ring_mul] THEN
    qed[RING_RULE `ring_mul(r:R ring) V (ring_mul r X C) = ring_mul r (ring_mul r V C) X`]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `ring_sum (x_ring(k:K ring)) S (\s. ring_mul (x_ring k) (monic_vanishing_at k S) (ring_sum (x_ring k) {i | i < m} (\i. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i))) = ring_mul (x_ring k) (monic_vanishing_at k S) (ring_sum (x_ring k) S (\s. ring_sum (x_ring k) {i | i < m} (\i. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i)))` THENL [
    have `monic_vanishing_at(k:K ring) S IN ring_carrier(x_ring k)` [monic_vanishing_at_in_x_ring] THEN
    have `!s:K. s IN S ==> ring_sum (x_ring k) {i | i < m} (\i. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i) IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
    specialize[`x_ring(k:K ring)`;`\s:K. ring_sum (x_ring k) {i | i < m} (\i. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i)`;`monic_vanishing_at(k:K ring) S`;`S:K->bool`]RING_SUM_LMUL THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `ring_sum (x_ring(k:K ring)) S (\s. ring_sum (x_ring k) {i | i < m} (\i. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i)) = ring_sum (x_ring k) {i | i < m} (\i. ring_sum (x_ring k) S (\s. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i))` THENL [
    have `FINITE (S:K->bool) /\ FINITE {i:num | i < m} /\ !(s:K) (i:num). s IN S /\ i IN {i:num | i < m} ==> (\x y. const_x_pow k (ring_mul k (v x) (ring_pow k x (m - 1 - y))) y) s i IN ring_carrier(x_ring(k:K ring))` [FINITE_NUMSEG_LT;SUBSET;RING_POW;RING_MUL;const_x_pow_in_x_ring] THEN
    specialize_raw[`x_ring(k:K ring)`;`\(s:K) i. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i`;`S:K->bool`;`{i:num | i < m}`]RING_SUM_SWAP THEN
    qed[]
  ; pass
  ] THEN
  simp[] THEN
  subgoal `!i:num. const_x_pow(k:K ring) (ring_sum k S (\s. ring_mul k (v s) (ring_pow k s (m-1-i)))) i = ring_sum (x_ring k) S (\s. const_x_pow k (ring_mul k (v s) (ring_pow k s (m - 1 - i))) i)` THENL [
    intro THEN
    have `!s:K. s IN S ==> ring_mul k (v s) (ring_pow k s (m - 1 - i)) IN ring_carrier k` [const_x_pow_in_x_ring;RING_MUL;SUBSET;RING_POW] THEN
    specialize[`k:K ring`;`S:K->bool`;`\s:K. ring_mul k (v s) (ring_pow k s (m - 1 - i))`;`i:num`]sum_const_x_pow_samedeg THEN
    qed[]
  ; pass
  ] THEN
  simp[]
);;

let goppa_parity = prove(`
  !(k:K ring) S G A (c:K->K).
  field k ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  G IN ring_carrier(x_ring k) ==>
  ~(G = poly_0 k) ==>
  A = monic_vanishing_at k S ==> 
  ring_coprime(x_ring k) (G,A) ==>
  (!s. s IN S ==> c s IN ring_carrier k) ==>
  (ring_divides(x_ring k) G
     (ring_sum(x_ring k) S
        (\s. ring_mul(x_ring k)
               (poly_const k (c s))
               (monic_vanishing_at_except k S s)))
   <=>
   (!d. 2 EXP d < twodeg k G ==>
    ring_sum k S
      (\s. ring_div k
             (ring_mul k (c s) (ring_pow k s d))
             (poly_eval k s G))
    = ring_0 k))
`,
  intro THEN
  have `integral_domain (k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  def `C:(num->num)->K` `(ring_sum(x_ring(k:K ring)) S (\s. ring_mul(x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)))` THEN
  def `B:(num->num)->K` `(ring_sum(x_ring(k:K ring)) S (\s. ring_mul(x_ring k) (poly_const k (ring_div k (c s) (poly_eval k s G))) (monic_vanishing_at_except k S s)))` THEN
  have `C IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `B IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
  have `ring_mul(x_ring k) G B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_sub(x_ring k) C (ring_mul(x_ring k) G B) IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `!s:K. s IN S ==> poly_const k ((c:K->K) s) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
  have `!s:K. s IN S ==> poly_eval k s G IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> ring_div k (c s) (poly_eval k s G) IN ring_carrier(k:K ring)` [RING_DIV] THEN
  subgoal `!s:K. s IN S ==> poly_eval k s (ring_sub(x_ring k) C (ring_mul(x_ring k) G B)) = ring_0(k:K ring)` THENL [
    intro THEN
    havetac `poly_eval(k:K ring) s C = ring_mul k (c s) (poly_eval k s (monic_vanishing_at_except k S s))` (simp[eval_sum_monic_vanishing_at_except]) THEN
    have `poly_const k (ring_div k (c s) (poly_eval k s G)) IN ring_carrier(x_ring(k:K ring))` [poly_const_in_x_ring] THEN
    havetac `poly_eval(k:K ring) s B = ring_mul k ((ring_div k (c s) (poly_eval k s G))) (poly_eval k s (monic_vanishing_at_except k S s))` (simp[eval_sum_monic_vanishing_at_except]) THEN
    have `(s:K) IN ring_carrier k` [SUBSET] THEN
    have `(c:K->K) s IN ring_carrier k` [] THEN
    have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
    have `poly_eval(k:K ring) s A = ring_0 k` [monic_vanishing_at_vanishes] THEN
    have `~(poly_eval(k:K ring) s G = ring_0 k)` [not_coprime_if_shared_root] THEN
    have `poly_eval(k:K ring) s G IN ring_carrier k` [poly_eval_in_ring] THEN
    have `poly_eval(k:K ring) s C IN ring_carrier k` [poly_eval_in_ring] THEN
    have `poly_eval(k:K ring) s B IN ring_carrier k` [poly_eval_in_ring] THEN
    have `poly_eval(k:K ring) s (monic_vanishing_at_except k S s) IN ring_carrier k` [poly_eval_in_ring] THEN
    specialize[`k:K ring`;`poly_eval(k:K ring) s (monic_vanishing_at_except k S s)`;`poly_eval(k:K ring) s G`;`(c:K->K) s`]field_mul_mul_div_cancel THEN
    have `ring_mul(k:K ring) (poly_eval k s G) (poly_eval k s B) = poly_eval k s C` [] THEN
    have `poly_eval(k:K ring) s (ring_mul(x_ring k) G B) = poly_eval k s C` [poly_eval_mul] THEN
    have `poly_eval(k:K ring) s (ring_sub (x_ring k) C (ring_mul (x_ring k) G B)) = ring_sub k (poly_eval k s C) (poly_eval k s (ring_mul(x_ring k) G B))` [poly_eval_sub] THEN
    have `poly_eval(k:K ring) s (ring_sub (x_ring k) C (ring_mul (x_ring k) G B)) = ring_sub k (poly_eval k s C) (poly_eval k s C)` [] THEN
    qed[RING_SUB_REFL]
  ; pass
  ] THEN
  have `ring_divides(x_ring(k:K ring)) A (ring_sub(x_ring k) C (ring_mul(x_ring k) G B))` [monic_vanishing_at_divides_if_roots] THEN
  def `m:num` `maximum (x_support(k:K ring) G)` THEN
  have `twodeg(k:K ring) G = 2 EXP m` [twodeg] THEN
  subgoal `ring_divides(x_ring(k:K ring)) G C <=> 2 EXP m * twodeg k B < 2 EXP CARD(S:K->bool)` THENL [
    EQ_TAC THENL [
      intro THEN
      choose `CG:(num->num)->K` `CG IN ring_carrier(x_ring(k:K ring)) /\ C = ring_mul(x_ring k) G CG` [ring_divides] THEN
      have `ring_sub(x_ring(k:K ring)) C (ring_mul(x_ring k) G B) = ring_mul(x_ring k) G (ring_sub(x_ring k) CG B)` [RING_RULE `C = ring_mul(r:R ring) G CG ==> ring_sub r C (ring_mul r G B) = ring_mul r G (ring_sub r CG B)`] THEN
      have `ring_divides(x_ring(k:K ring)) A (ring_mul(x_ring k) G (ring_sub(x_ring k) CG B))` [] THEN
      have `ring_co1(x_ring(k:K ring)) G A` [x_ring_coprime_co1] THEN
      have `ring_co1(x_ring(k:K ring)) A G` [ring_co1_sym] THEN
      have `ring_sub(x_ring k) CG B IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
      have `A IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
      have `ring_divides(x_ring(k:K ring)) A (ring_sub(x_ring k) CG B)` [ring_divides_if_divides_mul_co1] THEN
      specialize[`k:K ring`;`S:K->bool`;`c:K->K`]twodeg_sum_monic_vanishing_at_except THEN
      specialize[`k:K ring`;`S:K->bool`;`\s:K. ring_div(k:K ring) (c s) (poly_eval k s G)`]twodeg_sum_monic_vanishing_at_except THEN
      have `twodeg(k:K ring) C < 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) B < 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) G B) = twodeg k G * twodeg k B` [twodeg_mul] THEN
      have `2 EXP m * twodeg(k:K ring) B < 2 EXP m * 2 EXP CARD(S:K->bool)` [LT_LMULT;twopow_nonzero] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) G B) < 2 EXP m * 2 EXP CARD(S:K->bool)` [] THEN
      have `1 <= 2 EXP m` [twopow_ge1] THEN
      have `2 EXP CARD S <= 2 EXP m * 2 EXP CARD(S:K->bool)` [LE_MULT2;LE_REFL;ARITH_RULE `1 * H = H`] THEN
      have `twodeg(k:K ring) C < 2 EXP m * 2 EXP CARD(S:K->bool)` [LTE_TRANS] THEN
      have `twodeg(k:K ring) (ring_sub(x_ring k) C (ring_mul(x_ring k) G B)) < 2 EXP m * 2 EXP CARD(S:K->bool)` [twodeg_sub_lt] THEN
      have `twodeg(k:K ring) (ring_mul (x_ring k) G (ring_sub (x_ring k) CG B)) = twodeg k G * twodeg k (ring_sub (x_ring k) CG B)` [twodeg_mul] THEN
      have `twodeg(k:K ring) (ring_mul (x_ring k) G (ring_sub (x_ring k) CG B)) = 2 EXP m * twodeg k (ring_sub (x_ring k) CG B)` [] THEN
      have `2 EXP m * twodeg(k:K ring) (ring_sub (x_ring k) CG B) < 2 EXP m * 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) (ring_sub (x_ring k) CG B) < 2 EXP CARD(S:K->bool)` [LT_MULT_LCANCEL] THEN
      have `twodeg(k:K ring) (ring_sub (x_ring k) CG B) < twodeg k A` [twodeg_monic_vanishing_at] THEN
      have `ring_sub(x_ring(k:K ring)) CG B = poly_0 k` [twodeg_divides_le;NOT_LT] THEN
      have `ring_sub(x_ring(k:K ring)) CG B = ring_0(x_ring k)` [x_ring_0] THEN
      have `B = CG:(num->num)->K` [RING_SUB_EQ_0] THEN
      have `twodeg(k:K ring) C = twodeg k G * twodeg k CG` [twodeg_mul] THEN
      have `twodeg(k:K ring) C = 2 EXP m * twodeg k B` [] THEN
      qed[]
    ;
      intro THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) G B) = twodeg k G * twodeg k B` [twodeg_mul] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) G B) < 2 EXP CARD(S:K->bool)` [] THEN
      specialize[`k:K ring`;`S:K->bool`;`c:K->K`]twodeg_sum_monic_vanishing_at_except THEN
      have `twodeg(k:K ring) C < 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) (ring_sub(x_ring k) C (ring_mul(x_ring k) G B)) < 2 EXP CARD(S:K->bool)` [twodeg_sub_lt] THEN
      have `twodeg(k:K ring) (ring_sub(x_ring k) C (ring_mul(x_ring k) G B)) < twodeg k A` [twodeg_monic_vanishing_at] THEN
      have `ring_sub(x_ring(k:K ring)) C (ring_mul(x_ring k) G B) = poly_0 k` [twodeg_divides_le;NOT_LT] THEN
      have `ring_sub(x_ring(k:K ring)) C (ring_mul(x_ring k) G B) = ring_0(x_ring k)` [x_ring_0] THEN
      have `C = ring_mul(x_ring(k:K ring)) G B` [RING_SUB_EQ_0] THEN
      qed[ring_divides]
    ]
  ; pass
  ] THEN
  have `!s:K. s IN S ==> s IN ring_carrier(k:K ring)` [SUBSET] THEN
  have `!s:K. s IN S ==> ring_pow k s m IN ring_carrier(k:K ring)` [RING_POW] THEN
  have `!s:K. s IN S ==> ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s m) IN ring_carrier(k:K ring)` [RING_MUL] THEN
  def `Q:(num->num)->K` `(ring_sum(x_ring(k:K ring)) S (\s. ring_mul(x_ring k) (poly_const k (ring_mul k ((ring_div k (c s) (poly_eval k s G))) (ring_pow k s m))) (monic_vanishing_at_except k S s)))` THEN
  subgoal `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) (x_pow k m) B) Q = ring_mul (x_ring k) A (ring_sum (x_ring k) {d | d < m} (\d. const_x_pow k (ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))) d))` THENL [
    have `!s:K. s IN S ==> ring_div k (c s) (poly_eval k s G) IN ring_carrier k` [RING_DIV;poly_eval_in_ring] THEN
    specialize[`k:K ring`;`S:K->bool`;`\s:K. ring_div k (c s) (poly_eval k s G)`;`m:num`]goppa_parity_lemma THEN
    qed[]
  ; pass
  ] THEN
  have `ring_divides(x_ring(k:K ring)) A (ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) (x_pow k m) B) Q)` [ring_divides;RING_SUB;RING_MUL;x_pow_in_x_ring;RING_SUM] THEN
  EQ_TAC THENL [
    intro THEN
    subgoal `twodeg(k:K ring) (ring_sub (x_ring k) (ring_mul (x_ring k) (x_pow k m) B) Q) < twodeg k A` THENL [
      have `2 EXP m * twodeg(k:K ring) B < 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) (x_pow k m) = 2 EXP m` [twodeg_x_pow;integral_domain] THEN
      have `x_pow(k:K ring) m IN ring_carrier(x_ring k)` [x_pow_in_x_ring] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) (x_pow k m) B) = twodeg k (x_pow k m) * twodeg k B` [twodeg_mul] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) (x_pow k m) B) = 2 EXP m * twodeg k B` [] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) (x_pow k m) B) < 2 EXP CARD(S:K->bool)` [] THEN
      specialize[`k:K ring`;`S:K->bool`;`\s:K. ring_mul k (ring_div(k:K ring) (c s) (poly_eval k s G)) (ring_pow k s m)`]twodeg_sum_monic_vanishing_at_except THEN
      have `twodeg(k:K ring) Q < 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) (ring_sub (x_ring k) (ring_mul (x_ring k) (x_pow k m) B) Q) < 2 EXP CARD(S:K->bool)` [twodeg_sub_lt;RING_MUL;RING_SUM] THEN
      qed[twodeg_monic_vanishing_at]
    ; pass
    ] THEN
    subgoal `ring_sum (x_ring(k:K ring)) {d | d < m} (\d. const_x_pow k (ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))) d) = poly_0 k` THENL [
      have `~(twodeg k A <= twodeg(k:K ring) (ring_sub (x_ring k) (ring_mul (x_ring k) (x_pow k m) B) Q))` [NOT_LT] THEN
      have `ring_sub (x_ring k) (ring_mul (x_ring k) (x_pow k m) B) Q = ring_0(x_ring(k:K ring))` [ISPECL[`k:K ring`;`A:(num->num)->K`;`ring_sub (x_ring(k:K ring)) (ring_mul (x_ring k) (x_pow k m) B) Q`]twodeg_divides_le;x_ring_0] THEN
      have `~(A = ring_0(x_ring(k:K ring)))` [monic_vanishing_at_nonzero;x_ring_0] THEN
      rw[GSYM x_ring_0] THEN
      qed[integral_domain;x_ring_domain;monic_vanishing_at_in_x_ring;RING_SUM;monic_vanishing_at_nonzero]
    ; pass
    ] THEN
    have `d < m:num` [twopow_mono_lt] THEN
    num_linear `d < m:num ==> m-1-(m-1-d) = d` THEN
    num_linear `m-1-d <= m-1` THEN
    have `m-1 < m` [minus_1_lt_if_lt] THEN
    have `m-1-d < m` [LET_TRANS] THEN
    have `!d. d < m ==> ring_sum(k:K ring) S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d))) IN ring_carrier(k:K ring)` [RING_SUM] THEN
    specialize[`k:K ring`;`m-1-d`;`\d. ring_sum(k:K ring) S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))`;`m:num`]coeff_sum_const_x_pow THEN
    have `coeff (m-1-d) (ring_sum (x_ring(k:K ring)) {d | d < m} (\d. const_x_pow k (ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))) d)) = ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - (m-1-d))))` [] THEN
    have `coeff (m-1-d) (poly_0(k:K ring)) = ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - (m-1-d))))` [] THEN
    have `ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - (m-1-d)))) = ring_0(k:K ring)` [coeff_0] THEN
    have `!s:K. s IN S ==> ring_div k (ring_mul k (c s) (ring_pow k s d)) (poly_eval k s G) = ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - (m - 1 - d)))` [ring_div_mul_mul_div;RING_POW;RING_DIV;poly_eval_in_ring] THEN
    simp[] THEN
    qed[]
  ; intro THEN
    subgoal `!d. d < m ==> ring_sum(k:K ring) S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d))) = ring_0 k` THENL [
      intro THEN
      have `m-1 < m` [minus_1_lt_if_lt] THEN
      num_linear `m-1-d <= m-1` THEN
      have `m-1-d < m` [LET_TRANS] THEN
      have `2 EXP (m-1-d) < twodeg(k:K ring) G` [twopow_mono_lt] THEN
      have `ring_sum (k:K ring) S (\s. ring_div k (ring_mul k (c s) (ring_pow k s (m-1-d))) (poly_eval k s G)) = ring_0 k` [] THEN
      have `!s. s IN S ==> ring_div(k:K ring) (ring_mul k (c s) (ring_pow k s (m-1-d))) (poly_eval k s G) = ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d))` [SUBSET;ring_div_mul_mul_div;RING_POW;RING_DIV;RING_MUL;poly_eval_in_ring] THEN
      specialize[`k:K ring`;`\s. ring_div(k:K ring) (ring_mul k (c s) (ring_pow k s (m-1-d))) (poly_eval k s G)`;`\s. ring_mul(k:K ring) (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d))`;`S:K->bool`]RING_SUM_EQ THEN
      qed[]
    ; pass
    ] THEN
    have `!d. d < m ==> const_x_pow k (ring_sum(k:K ring) S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))) d = ring_0(x_ring k)` [const_x_pow_0;x_ring_0] THEN
    set_tac `!d:num. d IN {d | d < m} ==> d < m` [] THEN
    have `!d:num. d IN {d | d < m} ==> const_x_pow k (ring_sum(k:K ring) S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))) d = ring_0(x_ring k)` [] THEN
    have `ring_sum (x_ring(k:K ring)) {d | d < m} (\d. const_x_pow k (ring_sum k S (\s. ring_mul k (ring_div k (c s) (poly_eval k s G)) (ring_pow k s (m - 1 - d)))) d) = ring_0(x_ring k)` [RING_SUM_EQ_0] THEN
    have `ring_sub (x_ring k) (ring_mul (x_ring k) (x_pow k m) B) Q = ring_mul(x_ring k) A (ring_0(x_ring(k:K ring)))` [] THEN
    have `ring_sub(x_ring k) (ring_mul(x_ring k) (x_pow k m) B) Q = ring_0(x_ring(k:K ring))` [ring_mul_0;monic_vanishing_at_in_x_ring] THEN
    have `ring_mul(x_ring(k:K ring)) (x_pow k m) B = Q` [RING_SUB_EQ_0;RING_SUM;RING_MUL;x_pow_in_x_ring] THEN
    specialize[`k:K ring`;`S:K->bool`;`\s:K. ring_mul k (ring_div(k:K ring) (c s) (poly_eval k s G)) (ring_pow k s m)`]twodeg_sum_monic_vanishing_at_except THEN
    have `twodeg(k:K ring) Q < 2 EXP CARD(S:K->bool)` [] THEN
    have `twodeg(k:K ring) Q = twodeg k (x_pow k m) * twodeg k B` [twodeg_mul;x_pow_in_x_ring] THEN
    have `twodeg(k:K ring) (x_pow k m) = 2 EXP m` [twodeg_x_pow;integral_domain] THEN
    have `twodeg(k:K ring) Q = 2 EXP m * twodeg k B` [] THEN
    qed[]
  ]
);;

(* ----- Goppa squaring *)

let derivative_is_square = prove(`
  !(k:K ring) p.
  field k ==>
  FINITE(ring_carrier k) ==>
  ring_char k = 2 ==>
  p IN ring_carrier(x_ring k) ==>
  (?q.
      q IN ring_carrier(x_ring k)
   /\ x_derivative k p = ring_pow(x_ring k) q 2
  )
`,
  intro THEN
  have `integral_domain(k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `ring_char(x_ring(k:K ring)) = 2` [x_ring_char] THEN
  have `prime 2` [PRIME_2] THEN
  def `qcoeff:num->K` `\d. @x. x IN ring_carrier(k:K ring) /\ coeff (2*d+1) p = ring_mul k x x` THEN
  have `!d:num. coeff (2*d+1) p IN ring_carrier(k:K ring)` [coeff_in_ring] THEN
  subgoal `!d:num. qcoeff d IN ring_carrier(k:K ring) /\ coeff (2*d+1) p = ring_mul k (qcoeff d) (qcoeff d)` THENL [
    have `!d:num. ?x. x IN ring_carrier(k:K ring) /\ coeff (2*d+1) p = ring_mul k x x` [domain_perfect_if_finite_char2] THEN
    qed[]
  ; pass
  ] THEN
  def `H:num` `twodeg(k:K ring) p` THEN
  def `E:num->bool` `{d | 2 EXP d <= H}` THEN
  have `FINITE (E:num->bool)` [twopow_finite] THEN
  def `q:(num->num)->K` `ring_sum(x_ring(k:K ring)) E (\d:num. const_x_pow k (qcoeff d) d)` THEN
  EXISTS_TAC `q:(num->num)->K` THEN
  conjunction [
    qed[RING_SUM]
  ; pass
  ] THEN
  have `!d. d IN E ==> const_x_pow k (qcoeff d) d IN ring_carrier(x_ring(k:K ring))` [const_x_pow_in_x_ring] THEN
  specialize[`x_ring(k:K ring)`;`2`;`\d:num. const_x_pow (k:K ring) (qcoeff d) d`;`E:num->bool`]freshman_binomial_theorem_sum THEN
  have `ring_pow(x_ring(k:K ring)) q 2 = ring_sum(x_ring k) E (\d. ring_pow(x_ring k) (const_x_pow k (qcoeff d) d) 2)` [] THEN
  subgoal `!d. ring_pow(x_ring(k:K ring)) (const_x_pow k (qcoeff d) d) 2 = const_x_pow k (coeff(2*d+1) p) (2*d)` THENL [
    intro THEN
    have `ring_pow(x_ring(k:K ring)) (const_x_pow k (qcoeff d) d) 2 = const_x_pow k (ring_pow k (qcoeff d) 2) (d*2)` [const_x_pow_pow] THEN
    have `ring_pow(x_ring(k:K ring)) (const_x_pow k (qcoeff d) d) 2 = const_x_pow k (ring_pow k (qcoeff d) 2) (2*d)` [ARITH_RULE `2*d = d*2`] THEN
    have `ring_pow(k:K ring) (qcoeff d) 2 = coeff (2*d+1) p` [RING_POW_2] THEN
    qed[]
  ; pass
  ] THEN
  have `ring_pow(x_ring(k:K ring)) q 2 = ring_sum (x_ring k) E (\d. const_x_pow k (coeff (2 * d + 1) p) (2 * d))` [RING_SUM_EQ] THEN
  subgoal `!e:num. coeff e (x_derivative(k:K ring) p) = coeff e (ring_pow (x_ring k) q 2)` THENL [
    intro THEN
    rw[coeff_x_derivative] THEN
    ASM_CASES_TAC `EVEN e` THENL [
      choose `i:num` `e = 2*i` [EVEN_EXISTS] THEN
      have `2 divides e` [divides] THEN
      subgoal `ring_mul(k:K ring) (ring_of_num k (e+1)) (coeff (e+1) p) = coeff (e+1) p` THENL [
        have `ring_of_num(k:K ring) e = ring_0 k` [RING_OF_NUM_EQ_0] THEN
        have `ring_of_num(k:K ring) (e+1) = ring_of_num k 1` [RING_OF_NUM_ADD;ring_0_add;RING_OF_NUM] THEN
        have `ring_of_num(k:K ring) (e+1) = ring_1 k` [RING_OF_NUM_1] THEN
        qed[ring_1_mul]
      ; pass
      ] THEN
      subgoal `coeff e (ring_pow(x_ring(k:K ring)) q 2) = (if i IN E then coeff(2*i+1) p else ring_0 k)` THENL [
        specialize_raw[`k:K ring`;`e:num`;`\d. const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)`;`E:num->bool`]coeff_sum THEN
        have `coeff e (ring_pow(x_ring(k:K ring)) q 2) = ring_sum k E (\d. coeff e (const_x_pow k (coeff(2*d+1) p) (2*d)))` [const_x_pow_in_x_ring] THEN
        have `!d. coeff (2*i) (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)) = if 2*i = 2*d then coeff(2*d+1) p else ring_0 k` [coeff_const_x_pow] THEN
        have `!d. coeff (2*i) (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)) = if d = i then coeff(2*d+1) p else ring_0 k` [ARITH_RULE `d = i <=> 2*d = 2*i`] THEN
        have `!d. coeff e (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)) = if d = i then coeff(2*d+1) p else ring_0 k` [] THEN
        specialize_raw[`k:K ring`;`\d:num. coeff e (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d))`;`\d:num. if d = i then coeff(2*d+1) p else ring_0(k:K ring)`;`E:num->bool`]RING_SUM_EQ THEN
        have `coeff e (ring_pow(x_ring(k:K ring)) q 2) = ring_sum k E (\d. if d = i then coeff(2*d+1) p else ring_0 k)` [] THEN
        specialize_raw[`k:K ring`;`E:num->bool`;`i:num`;`\d:num. coeff(2*d+1) p:K`]ring_sum_delta_fun THEN
        qed[coeff_in_ring]
      ; pass
      ] THEN
      ASM_CASES_TAC `2 EXP i <= H` THENL [
        set_tac `2 EXP i <= H ==> i IN {d | 2 EXP d <= H}` [] THEN
        qed[]
      ;
        num_linear `~(2 EXP i <= H) ==> H < 2 EXP i` THEN
        have `H * H < 2 EXP i * 2 EXP i` [LT_MULT2] THEN
        have `H * H < 2 EXP e` [EXP_ADD;ARITH_RULE `i+i = 2*i`] THEN
        have `H:num <= H * H` [LE_SQUARE_REFL] THEN
        have `H < 2 EXP e` [LET_TRANS] THEN
        have `2 EXP e < 2 EXP (e+1)` [twopow_mono_lt;ARITH_RULE `e < e+1`] THEN
        have `H < 2 EXP (e+1)` [LT_TRANS] THEN
        have `coeff (e+1) p = ring_0(k:K ring)` [support_le_twodeg;NOT_LT] THEN
        qed[]
      ]
    ;
      choose `i:num` `e = SUC(2*i)` [ODD_EXISTS;NOT_ODD] THEN
      subgoal `ring_mul k (ring_of_num(k:K ring) (e+1)) (coeff(e+1) p) = ring_0 k` THENL [
        num_linear `e = SUC(2*i) ==> e+1 = 2*(i+1)` THEN
        have `2 divides e+1` [divides] THEN
        have `ring_of_num(k:K ring) (e+1) = ring_0 k` [RING_OF_NUM_EQ_0] THEN
        qed[ring_0_mul;coeff_in_ring]
      ; pass
      ] THEN
      subgoal `coeff e (ring_pow(x_ring(k:K ring)) q 2) = ring_0 k` THENL [
        specialize_raw[`k:K ring`;`e:num`;`\d. const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)`;`E:num->bool`]coeff_sum THEN
        have `coeff e (ring_pow(x_ring(k:K ring)) q 2) = ring_sum k E (\d. coeff e (const_x_pow k (coeff(2*d+1) p) (2*d)))` [const_x_pow_in_x_ring] THEN
        have `!d. coeff e (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)) = if e = 2*d then coeff(2*d+1) p else ring_0 k` [coeff_const_x_pow] THEN
        have `!d. ~(e = 2*d)` [EVEN_DOUBLE;NOT_EVEN] THEN
        have `!d. coeff e (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)) = ring_0 k` [] THEN
        have `!d. coeff e (const_x_pow(k:K ring) (coeff(2*d+1) p) (2*d)) = ring_0 k` [ARITH_RULE `e = SUC(2*i) ==> e = 2*i+1`] THEN
        qed[RING_SUM_EQ_0]
      ; pass
      ] THEN
      qed[]
    ;
    ]
  ; qed[eq_if_coeff_eq;RING_SUM;x_derivative_in_x_ring]
  ]
);;

let goppa_squaring = prove(`
  !(k:K ring) S A g c Q.
  field k ==>
  FINITE(ring_carrier k) ==>
  ring_char k = 2 ==>
  S SUBSET ring_carrier k ==>
  A = monic_vanishing_at k S ==>
  g IN ring_carrier(x_ring k) ==>
  ring_squarefree(x_ring k) g ==>
  ring_coprime(x_ring k) (g,A) ==>
  (!s. s IN S ==> (c s = ring_0 k \/ c s = ring_1 k)) ==>
  Q = ring_sum(x_ring k) S
        (\s. ring_mul(x_ring k)
               (poly_const k (c s))
               (monic_vanishing_at_except k S s)) ==>
  (
   ring_divides(x_ring k) g Q
   <=>
   ring_divides(x_ring k) (ring_mul(x_ring k) g g) Q
  )
`,
  intro THEN
  have `integral_domain(k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `FINITE(S:K->bool)` [FINITE_SUBSET] THEN
  subgoal `S = {s:K | s IN S /\ (c:K->K) s = ring_0 k} UNION {s:K | s IN S /\ c s = ring_1 k}` THENL [
    rw[EXTENSION;IN_UNION;IN_ELIM_THM] THEN
    qed[]
  ; pass
  ] THEN
  subgoal `DISJOINT {s:K | s IN S /\ (c:K->K) s = ring_0 k} {s:K | s IN S /\ c s = ring_1 k}` THENL [
    rw[IN_DISJOINT;IN_ELIM_THM;NOT_EXISTS_THM] THEN
    qed[integral_domain]
  ; pass
  ] THEN
  def `Z:(num->num)->K` `monic_vanishing_at(k:K ring) {s | s IN S /\ c s = ring_0 k}` THEN
  def `C:(num->num)->K` `monic_vanishing_at(k:K ring) {s | s IN S /\ c s = ring_1 k}` THEN
  have `A = ring_mul(x_ring(k:K ring)) Z C` [monic_vanishing_at_union] THEN
  have `ring_coprime(x_ring(k:K ring)) (g,Z)` [RING_COPRIME_RMUL;monic_vanishing_at_in_x_ring;x_ring_domain;x_ring_bezout] THEN
  subgoal `x_derivative(k:K ring) C = ring_sum(x_ring k) {s:K | s IN S /\ c s = ring_1 k} (\s. monic_vanishing_at_except k {s:K | s IN S /\ c s = ring_1 k} s)` THENL [
    have `FINITE {s:K | s IN S /\ c s = ring_1(k:K ring)}` [FINITE_UNION] THEN
    have `{s:K | s IN S /\ c s = ring_1(k:K ring)} SUBSET ring_carrier k` [UNION_SUBSET] THEN
    simp[derivative_monic_vanishing_at]
  ; pass
  ] THEN
  subgoal `Q = ring_mul(x_ring k) Z (x_derivative(k:K ring) C)` THENL [
    simp[] THEN
    have `FINITE {s:K | s IN S /\ c s = ring_0(k:K ring)}` [FINITE_UNION] THEN
    have `FINITE {s:K | s IN S /\ c s = ring_1(k:K ring)}` [FINITE_UNION] THEN
    specialize_raw[`x_ring(k:K ring)`;`\s:K. ring_mul (x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)`;`{s:K | s IN S /\ c s = ring_0(k:K ring)}`;`{s:K | s IN S /\ c s = ring_1(k:K ring)}`]RING_SUM_UNION THEN
    have `ring_sum (x_ring(k:K ring)) S (\s. ring_mul (x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)) = ring_add (x_ring k) (ring_sum (x_ring k) {s | s IN S /\ c s = ring_0 k} (\s. ring_mul (x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s))) (ring_sum (x_ring k) {s | s IN S /\ c s = ring_1 k} (\s. ring_mul (x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)))` [] THEN
    simp[] THEN
    set_tac `!s:K. s IN {s | s IN S /\ c s = ring_0(k:K ring)} ==> c s = ring_0(k:K ring)` [] THEN
    set_tac `!s:K. s IN {s | s IN S /\ c s = ring_1(k:K ring)} ==> c s = ring_1(k:K ring)` [] THEN
    have `!s:K. c s = ring_0(k:K ring) ==> poly_const k (c s) = ring_0(x_ring k)` [x_ring_0;poly_0] THEN
    have `!s:K. ring_mul (x_ring(k:K ring)) (ring_0(x_ring k)) (monic_vanishing_at_except k S s) = ring_0(x_ring k)` [ring_0_mul;monic_vanishing_at_except_in_x_ring] THEN
    have `!s:K. s IN {s | s IN S /\ c s = ring_0(k:K ring)} ==> ring_mul (x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s) = ring_0(x_ring k)` [] THEN
    have `ring_sum (x_ring k) {s:K | s IN S /\ c s = ring_0 k} (\s. ring_mul (x_ring k) (poly_const k (c s)) (monic_vanishing_at_except k S s)) = ring_0(x_ring k)` [RING_SUM_EQ_0] THEN
    simp[ring_0_add;RING_SUM] THEN
    simp[GSYM RING_SUM_LMUL;monic_vanishing_at_in_x_ring;monic_vanishing_at_except_in_x_ring] THEN
    rw[monic_vanishing_at_except] THEN
    have `!s:K. s IN {s:K | s IN S /\ c s = ring_1(k:K ring)} ==> S DELETE s = {s:K | s IN S /\ c s = ring_0(k:K ring)} UNION ({s:K | s IN S /\ c s = ring_1(k:K ring)} DELETE s)` [disjoint_union_delete_as_union] THEN
    have `!s:K. s IN {s:K | s IN S /\ c s = ring_1(k:K ring)} ==> DISJOINT {s:K | s IN S /\ c s = ring_0(k:K ring)} ({s:K | s IN S /\ c s = ring_1(k:K ring)} DELETE s)` [disjoint_union_delete_disjoint] THEN
    have `!s:K. S DELETE s SUBSET ring_carrier(k:K ring)` [DELETE_SUBSET;SUBSET_TRANS] THEN
    have `!s:K. s IN {s:K | s IN S /\ c s = ring_1(k:K ring)} ==> {s:K | s IN S /\ c s = ring_0(k:K ring)} UNION ({s:K | s IN S /\ c s = ring_1(k:K ring)} DELETE s) SUBSET ring_carrier(k:K ring)` [] THEN
    have `!s:K. s IN {s:K | s IN S /\ c s = ring_1(k:K ring)} ==> FINITE ({s:K | s IN S /\ c s = ring_0(k:K ring)} UNION ({s:K | s IN S /\ c s = ring_1(k:K ring)} DELETE s))` [FINITE_SUBSET] THEN
    have `!s:K. s IN {s:K | s IN S /\ c s = ring_1(k:K ring)} ==> monic_vanishing_at k (S DELETE s) = ring_mul(x_ring k) (monic_vanishing_at k {s | s IN S /\ c s = ring_0 k}) (monic_vanishing_at k ({s | s IN S /\ c s = ring_1 k} DELETE s))` [monic_vanishing_at_union] THEN
    simp[GSYM poly_1;GSYM x_ring_1;ring_1_mul;RING_MUL;monic_vanishing_at_in_x_ring]
  ; pass
  ] THEN
  EQ_TAC THENL [
    intro THEN
    have `ring_divides(x_ring(k:K ring)) g (x_derivative k C)` [ring_divides_if_divides_mul_co1;x_ring_coprime_co1;x_derivative_in_x_ring;RING_SUM;monic_vanishing_at_in_x_ring] THEN
    have `C IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
    choose `q:(num->num)->K` `q IN ring_carrier(x_ring k) /\ x_derivative(k:K ring) C = ring_pow(x_ring k) q 2` [derivative_is_square] THEN
    have `x_derivative(k:K ring) C = ring_mul(x_ring k) q q` [RING_POW_2] THEN
    have `ring_divides(x_ring(k:K ring)) g q` [ring_squarefree] THEN
    have `ring_divides(x_ring(k:K ring)) (ring_mul(x_ring k) g g) (ring_mul(x_ring k) q q)` [RING_DIVIDES_MUL2] THEN
    have `ring_divides(x_ring(k:K ring)) (ring_mul(x_ring k) g g) (x_derivative k C)` [] THEN
    qed[RING_DIVIDES_LMUL;monic_vanishing_at_in_x_ring]
  ;
    intro THEN
    have `ring_divides(x_ring(k:K ring)) g (ring_mul(x_ring k) g g)` [ring_divides] THEN
    qed[RING_DIVIDES_TRANS]
  ]
);;

(* ----- poly_shift *)

let subset_shift_image = prove(`
  !(r:R ring) S c.
  S SUBSET ring_carrier r ==>
  c IN ring_carrier r ==>
  IMAGE (\s:R. ring_sub r s c) S
  = {z:R | z IN ring_carrier r /\ ring_add r z c IN S}
`,
  rw[EXTENSION;IN_IMAGE;IN_ELIM_THM] THEN
  intro THEN
  EQ_TAC THENL [
    intro THEN
    qed[ring_sub_add_cancel;SUBSET;RING_SUB]
  ;
    intro THEN
    EXISTS_TAC `ring_add(r:R ring) x c` THEN
    qed[RING_RULE `ring_sub(r:R ring) (ring_add r x c) c = x`]
  ]
);;

let subset_shift_card = prove(`
  !(r:R ring) S c.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  c IN ring_carrier r ==>
  CARD {z:R | z IN ring_carrier r /\ ring_add r z c IN S} = CARD S
`,
  intro THEN
  have `!s:R. s IN S ==> s IN ring_carrier(r:R ring)` [SUBSET] THEN
  def `f:R->R` `\s:R. ring_sub r s c` THEN
  have `!x y:R. x IN S ==> y IN S ==> f x = f y:R ==> x = y` [RING_RULE `ring_sub(r:R ring) x c = ring_sub r y c ==> x = y`] THEN
  specialize[`f:R->R`;`S:R->bool`]CARD_IMAGE_INJ THEN
  qed[subset_shift_image]
);;

let subset_shift_finite = prove(`
  !(r:R ring) S c.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  c IN ring_carrier r ==>
  FINITE {z:R | z IN ring_carrier r /\ ring_add r z c IN S}
`,
  intro THEN
  have `!s:R. s IN S ==> s IN ring_carrier(r:R ring)` [SUBSET] THEN
  def `f:R->R` `\s:R. ring_sub r s c` THEN
  have `!x y:R. x IN S ==> y IN S ==> f x = f y:R ==> x = y` [RING_RULE `ring_sub(r:R ring) x c = ring_sub r y c ==> x = y`] THEN
  specialize[`f:R->R`;`S:R->bool`]FINITE_IMAGE_INJ_EQ THEN
  qed[subset_shift_image]
);;

let poly_shift = new_definition `
  poly_shift (r:R ring) c
  = poly_extend (r,x_ring r) (poly_const r) (\v:num. x_plus_const r c)
`;;

let poly_shift_in_x_ring = prove(`
  !(r:R ring) c p.
  poly_shift r c p IN ring_carrier(x_ring r)
`,
  qed[poly_shift;POLY_EXTEND]
);;

let poly_shift_morphism = prove(`
  !(r:R ring) c.
  c IN ring_carrier r ==>
  ring_homomorphism(x_ring r,x_ring r) (poly_shift r c)
`,
  intro THEN
  have `ring_homomorphism((r:R ring),x_ring r) (poly_const r:R->(num->num)->R)` [RING_HOMOMORPHISM_POLY_CONST;x_ring] THEN
  rw[poly_shift] THEN
  qed[RING_HOMOMORPHISM_POLY_EXTEND;x_plus_const_in_x_ring;x_ring]
);;

let poly_shift_0 = prove(`
  !(r:R ring) c.
  c IN ring_carrier r ==>
  poly_shift r c (poly_0 r) = poly_0 r
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_0;x_ring_0]
);;

let poly_shift_1 = prove(`
  !(r:R ring) c.
  c IN ring_carrier r ==>
  poly_shift r c (poly_1 r) = poly_1 r
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_1;x_ring_1]
);;

let poly_shift_neg = prove(`
  !(r:R ring) c p.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  poly_shift r c (ring_neg(x_ring r) p)
  = ring_neg(x_ring r) (poly_shift r c p)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_NEG]
);;

let poly_shift_add = prove(`
  !(r:R ring) c p q.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_shift r c (ring_add(x_ring r) p q)
  = ring_add(x_ring r) (poly_shift r c p) (poly_shift r c q)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_ADD]
);;

let poly_shift_sub = prove(`
  !(r:R ring) c p q.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_shift r c (ring_sub(x_ring r) p q)
  = ring_sub(x_ring r) (poly_shift r c p) (poly_shift r c q)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_SUB]
);;

let poly_shift_mul = prove(`
  !(r:R ring) c p q.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  q IN ring_carrier(x_ring r) ==>
  poly_shift r c (ring_mul(x_ring r) p q)
  = ring_mul(x_ring r) (poly_shift r c p) (poly_shift r c q)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_MUL]
);;

let poly_shift_pow = prove(`
  !(r:A ring) a p n.
  a IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  poly_shift r a (ring_pow(x_ring r) p n)
  = ring_pow(x_ring r) (poly_shift r a p) n
`,
  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN
  INDUCT_TAC THENL [
    simp[RING_POW_0;x_ring_1;poly_shift_1]
  ;
    simp[ring_pow] THEN
    simp[poly_shift_mul;RING_POW]
  ]
);;

let poly_shift_sum = prove(`
  !(r:R ring) c (f:X->(num->num)->R) S.
  c IN ring_carrier r ==>
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  poly_shift r c (ring_sum(x_ring r) S f)
  = ring_sum(x_ring r) S ((poly_shift r c) o f)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_SUM]
);;

let poly_shift_product = prove(`
  !(r:R ring) c (f:X->(num->num)->R) S.
  c IN ring_carrier r ==>
  FINITE S ==>
  (!s. s IN S ==> f s IN ring_carrier(x_ring r)) ==>
  poly_shift r c (ring_product(x_ring r) S f)
  = ring_product(x_ring r) S ((poly_shift r c) o f)
`,
  intro THEN
  have `ring_homomorphism(x_ring r,x_ring r) (poly_shift r (c:R))` [poly_shift_morphism] THEN
  qed[RING_HOMOMORPHISM_PRODUCT]
);;

let poly_shift_const_x_pow = prove(`
  !(r:R ring) a c d.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_shift r a (const_x_pow r c d)
  = ring_mul(x_ring r)
      (poly_const r c)
      (ring_pow(x_ring r) (x_plus_const r a) d)
`,
  intro THEN
  have `ring_homomorphism(r,x_ring r) (poly_const(r:R ring))` [RING_HOMOMORPHISM_POLY_CONST;x_ring] THEN
  have `{m | ~(const_x_pow r c d m = ring_0 (r:R ring))} SUBSET {map0to d}` [const_x_pow_monomials] THEN
  specialize[`{map0to d}`;`r:R ring`;`x_ring(r:R ring)`;`poly_const r:R->(num->num)->R`;`const_x_pow r (c:R) d`;`\v:num. x_plus_const r (a:R)`]POLY_EXTEND_SUPERSET THEN
  simp[poly_shift] THEN
  rw[RING_SUM_SING] THEN
  rw[map0to_monomial_vars] THEN
  rw[GSYM coeff] THEN
  simp[coeff_const_x_pow] THEN
  simp[RING_MUL;RING_PRODUCT;poly_const_in_x_ring] THEN
  handlecase `d = 0` (
    simp[RING_PRODUCT_CLAUSES] THEN
    rw[RING_POW_0] THEN
    simp[RING_MUL_RID] 
  ) THEN
  simp[RING_PRODUCT_SING;RING_POW;x_plus_const_in_x_ring] THEN
  simp[map0to]
);;

let poly_shift_const = prove(`
  !(r:R ring) a c.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_shift r a (poly_const r c)
  = poly_const r c
`,
  simp[GSYM const_x_pow_deg0] THEN
  simp[poly_shift_const_x_pow] THEN
  qed[RING_POW_0;x_plus_const_in_x_ring;ring_mul_1;poly_const_in_x_ring;const_x_pow_deg0]
);;

let poly_shift_x_pow = prove(`
  !(r:R ring) a d.
  a IN ring_carrier r ==>
  poly_shift r a (x_pow r d)
  = ring_pow(x_ring r) (x_plus_const r a) d
`,
  rw[GSYM const_x_pow_1] THEN
  simp[poly_shift_const_x_pow;RING_1] THEN
  rw[GSYM poly_1;GSYM x_ring_1] THEN
  qed[ring_1_mul;x_plus_const_in_x_ring;RING_POW]
);;

let poly_shift_x = prove(`
  !(r:R ring) a.
  a IN ring_carrier r ==>
  poly_shift r a (poly_x r)
  = x_plus_const r a
`,
  qed[poly_x;poly_shift_x_pow;RING_POW_1;x_plus_const_in_x_ring]
);;

let poly_shift_x_minus_const_as_plus = prove(`
  !(r:R ring) a c.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_shift r a (x_minus_const r c)
  = x_plus_const r (ring_sub r a c)
`,
  rw[x_minus_const] THEN
  simp[poly_shift_sub;poly_const_in_x_ring;x_in_x_ring] THEN
  simp[poly_shift_x;poly_shift_const] THEN
  rw[x_plus_const] THEN
  simp[poly_const_sub] THEN
  rw[GSYM x_ring_add] THEN
  qed[x_in_x_ring;poly_const_in_x_ring;RING_RULE `ring_sub(r:R ring) (ring_add r X A) C = ring_add r X (ring_sub r A C)`]
);;

let poly_shift_x_minus_const = prove(`
  !(r:R ring) a c.
  a IN ring_carrier r ==>
  c IN ring_carrier r ==>
  poly_shift r a (x_minus_const r c)
  = x_minus_const r (ring_sub r c a)
`,
  rw[x_minus_const] THEN
  simp[poly_shift_sub;poly_const_in_x_ring;x_in_x_ring] THEN
  simp[poly_shift_x;poly_shift_const] THEN
  rw[x_plus_const] THEN
  simp[poly_const_sub] THEN
  rw[GSYM x_ring_add] THEN
  qed[x_in_x_ring;poly_const_in_x_ring;RING_RULE `ring_sub(r:R ring) (ring_add r X A) C = ring_sub r X (ring_sub r C A)`]
);;

let x_derivative_poly_shift_const_x_pow = prove(`
  !(r:R ring) c p d.
  c IN ring_carrier r ==>
  p IN ring_carrier r ==>
  x_derivative r (poly_shift r c (const_x_pow r p d))
  = poly_shift r c (x_derivative r (const_x_pow r p d))
`,
  intro THEN
  simp[x_derivative_const_x_pow;poly_shift_const_x_pow] THEN
  simp[x_derivative_mul_const;x_plus_const_in_x_ring;RING_POW] THEN
  simp[poly_shift_const_x_pow;RING_MUL;RING_OF_NUM] THEN
  simp[x_derivative_pow;x_plus_const_in_x_ring] THEN
  simp[x_derivative_x_plus_const] THEN
  simp[POLY_CONST_MUL;RING_OF_NUM] THEN
  simp[x_ring_of_num] THEN
  simp[GSYM x_ring_1] THEN
  simp[GSYM x_ring_mul] THEN
  qed[RING_RULE `ring_mul(r:R ring) C (ring_mul r D (ring_mul r P (ring_1 r))) = ring_mul r (ring_mul r D C) P`;RING_POW;x_plus_const_in_x_ring;poly_const_in_x_ring;RING_OF_NUM]
);;

let x_derivative_poly_shift = prove(`
  !(r:R ring) c p.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  x_derivative r (poly_shift r c p)
  = poly_shift r c (x_derivative r p)
`,
  intro THEN
  have `p = ring_sum(x_ring(r:R ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d)` [x_ring_expand] THEN
  have `FINITE (x_support(r:R ring) p)` [finite_x_support] THEN
  have `x_derivative(r:R ring) p = ring_sum(x_ring r) (x_support r p) (x_derivative r o (\d. const_x_pow r (coeff d p) d))` [x_derivative_sum;const_x_pow_in_x_ring;coeff_in_ring] THEN
  have `poly_shift(r:R ring) c p = ring_sum(x_ring r) (x_support r p) (poly_shift r c o (\d. const_x_pow r (coeff d p) d))` [poly_shift_sum;const_x_pow_in_x_ring;coeff_in_ring] THEN
  simp[o_DEF] THEN
  simp[x_derivative_sum;poly_shift_in_x_ring;const_x_pow_in_x_ring;coeff_in_ring] THEN
  simp[o_DEF] THEN
  have `!d. x_derivative(r:R ring) (const_x_pow r (coeff d p) d) IN ring_carrier(x_ring r)` [x_derivative_in_x_ring;const_x_pow_in_x_ring;coeff_in_ring] THEN
  simp[poly_shift_sum;o_DEF] THEN
  simp[x_derivative_poly_shift_const_x_pow;coeff_in_ring]
);;

let poly_eval_shift_const_x_pow = prove(`
  !(r:R ring) s c d e.
  s IN ring_carrier r ==>
  c IN ring_carrier r ==>
  e IN ring_carrier r ==>
  poly_eval r e (poly_shift r s (const_x_pow r c d))
  = poly_eval r (ring_add r e s) (const_x_pow r c d)
`,
  simp[poly_shift_const_x_pow] THEN
  simp[poly_eval_const_x_pow;RING_ADD] THEN
  simp[poly_eval_mul;poly_const_in_x_ring;RING_POW;x_plus_const_in_x_ring] THEN
  simp[poly_eval_const] THEN
  simp[poly_eval_pow;x_plus_const_in_x_ring] THEN
  rw[x_plus_const;GSYM x_ring_add] THEN
  simp[poly_eval_add;x_in_x_ring;poly_const_in_x_ring] THEN
  simp[poly_eval_x;poly_eval_const]
);;

let poly_eval_shift = prove(`
  !(r:R ring) s p e.
  s IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  e IN ring_carrier r ==>
  poly_eval r e (poly_shift r s p)
  = poly_eval r (ring_add r e s) p
`,
  intro THEN
  have `p = ring_sum(x_ring(r:R ring)) (x_support r p) (\d. const_x_pow r (coeff d p) d)` [x_ring_expand] THEN
  have `ring_add(r:R ring) e s IN ring_carrier r` [RING_ADD] THEN
  have `FINITE (x_support(r:R ring) p)` [finite_x_support] THEN
  have `poly_eval(r:R ring) (ring_add r e s) p = ring_sum r (x_support r p) (poly_eval r (ring_add r e s) o (\d. const_x_pow r (coeff d p) d))` [poly_eval_sum;const_x_pow_in_x_ring;coeff_in_ring] THEN
  have `poly_shift(r:R ring) s p = ring_sum(x_ring r) (x_support r p) (poly_shift r s o (\d. const_x_pow r (coeff d p) d))` [poly_shift_sum;const_x_pow_in_x_ring;coeff_in_ring] THEN
  simp[o_DEF] THEN
  simp[poly_eval_sum;poly_shift_in_x_ring;const_x_pow_in_x_ring;coeff_in_ring] THEN
  simp[o_DEF] THEN
  have `!d. poly_eval(r:R ring) (ring_add r e s) (const_x_pow r (coeff d p) d) IN ring_carrier r` [poly_eval_in_ring;const_x_pow_in_x_ring;coeff_in_ring] THEN
  simp[poly_shift_sum;o_DEF] THEN
  simp[poly_eval_shift_const_x_pow;coeff_in_ring]
);;

let poly_shift_monic_vanishing_at = prove(`
  !(r:R ring) S c.
  S SUBSET ring_carrier r ==>
  FINITE S ==>
  c IN ring_carrier r ==>
  poly_shift r c (monic_vanishing_at r S)
  = monic_vanishing_at r {z:R | z IN ring_carrier r /\ ring_add r z c IN S}
`,
  intro THEN
  rw[monic_vanishing_at] THEN
  have `!s:R. s IN S ==> s IN ring_carrier(r:R ring)` [SUBSET] THEN
  have `!s:R. s IN S ==> x_minus_const(r:R ring) s IN ring_carrier(x_ring r)` [x_minus_const_in_x_ring] THEN
  simp[poly_shift_product;o_DEF;poly_shift_x_minus_const] THEN
  def `f:R->R` `\s:R. ring_sub r s c` THEN
  have `!x y:R. x IN S ==> y IN S ==> f x = f y:R ==> x = y` [RING_RULE `ring_sub(r:R ring) x c = ring_sub r y c ==> x = y`] THEN
  specialize[`x_ring(r:R ring)`;`f:R->R`;`\s:R. x_minus_const r s`;`S:R->bool`]RING_PRODUCT_IMAGE THEN
  havetac `ring_product (x_ring(r:R ring)) S (\s:R. x_minus_const r (ring_sub r s c)) = ring_product (x_ring r) S ((\s:R. x_minus_const r s) o f)` (rw[o_DEF] THEN qed[RING_PRODUCT_EQ]) THEN
  have `IMAGE (f:R->R) S = {z:R | z IN ring_carrier r /\ ring_add r z c IN S}` [subset_shift_image] THEN
  qed[]
);;

(* using this can prove eq by inverting poly_shift *)
(* but le is good enough for the context *)
let twodeg_poly_shift_le = prove(`
  !(r:R ring) c p.
  c IN ring_carrier r ==>
  p IN ring_carrier(x_ring r) ==>
  twodeg r (poly_shift r c p) <= twodeg r p
`,
  intro THEN
  num_linear `twodeg(r:R ring) p <= twodeg r p` THEN
  specialize[`r:R ring`;`p:(num->num)->R`;`twodeg(r:R ring) p`]x_ring_expand_twodeg THEN
  specialize[`twodeg(r:R ring) p`]twopow_finite THEN
  have `poly_shift(r:R ring) c p = ring_sum(x_ring r) {d | 2 EXP d <= twodeg r p} (poly_shift r c o (\d. const_x_pow r (coeff d p) d))` [poly_shift_sum;const_x_pow_in_x_ring;coeff_in_ring] THEN
  have `poly_shift(r:R ring) c p = ring_sum(x_ring r) {d | 2 EXP d <= twodeg r p} (\d. poly_shift r c (const_x_pow r (coeff d p) d))` [o_THM;RING_SUM_EQ] THEN
  subgoal `!d. d IN {d | 2 EXP d <= twodeg r p} ==> twodeg(r:R ring) (poly_shift r c (const_x_pow r (coeff d p) d)) <= twodeg r p` THENL [
    intro THEN
    simp[poly_shift_const_x_pow;coeff_in_ring] THEN
    have `twodeg(r:R ring) (poly_const r (coeff d p)) <= 1` [twodeg_poly_const;coeff_in_ring;ARITH_RULE `0 <= 1`;ARITH_RULE `2 EXP 0 <= 1`] THEN
    have `twodeg(r:R ring) (x_plus_const r c) <= 2` [twodeg_x_plus_const;ARITH_RULE `0 <= 2`;ARITH_RULE `2 EXP 1 <= 2`] THEN
    have `twodeg(r:R ring) (ring_pow(x_ring r) (x_plus_const r c) d) <= 2 EXP d` [twodeg_pow_le;x_plus_const_in_x_ring] THEN
    have `twodeg(r:R ring) (ring_mul(x_ring r) (poly_const r (coeff d p)) (ring_pow(x_ring r) (x_plus_const r c) d)) <= 1 * 2 EXP d` [twodeg_mul_le;x_plus_const_in_x_ring;poly_const_in_x_ring;coeff_in_ring;RING_POW] THEN
    have `twodeg(r:R ring) (ring_mul(x_ring r) (poly_const r (coeff d p)) (ring_pow(x_ring r) (x_plus_const r c) d)) <= 2 EXP d` [ARITH_RULE `1 * 2 EXP d = 2 EXP d`] THEN
    set_tac `d IN {d | 2 EXP d <= twodeg(r:R ring) p} ==> 2 EXP d <= twodeg r p` [] THEN
    qed[LE_TRANS]
  ; qed[twodeg_sum_le]
  ]
);;

(* ----- closer look at binary Goppa codes *)

let goppa_checking_2_barlemma = prove(`
  !(k:K ring) A B t a b D h q u.
  u IN ring_carrier k ==>
  A IN ring_carrier(x_ring k) ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  D IN ring_carrier(x_ring k) ==>
  h IN ring_carrier(x_ring k) ==>
  q IN ring_carrier(x_ring k) ==>
  a = ring_mul(x_ring k) (x_minus_const k u) q ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  ~(t = 0) ==>
  poly_shift k u
    (ring_mul(x_ring k)
       (ring_pow(x_ring k) (x_minus_const k u) (2*t-1))
       (ring_mul(x_ring k) h aBbA))
  = ring_sub(x_ring k)
      (ring_mul(x_ring k)
         (x_pow k (2*t))
         (poly_shift k u
            (ring_mul(x_ring k)
               (ring_mul(x_ring k) h q)
               B)))
      (ring_mul(x_ring k)
         (x_pow k (2*t-1))
         (ring_mul(x_ring k)
            (poly_shift k u
               (ring_mul(x_ring k) h b))
            (poly_shift k u A)))
`,
  intro THEN
  num_linear `~(t = 0) ==> 2*t = SUC(2*t-1)` THEN
  have `x_pow(k:K ring) (2*t) = ring_mul(x_ring k) (poly_x k) (x_pow k (2*t-1))` [x_then_pow_is_x_pow;ring_pow] THEN
  simp[] THEN
  have `poly_shift k u (x_minus_const k u) = poly_x(k:K ring)` [poly_shift_x_minus_const;RING_SUB_REFL;x_minus_const_0] THEN
  have `x_minus_const k u IN ring_carrier(x_ring(k:K ring))` [x_minus_const_in_x_ring] THEN
  have `ring_pow(x_ring k) (x_minus_const k u) (2*t-1) IN ring_carrier(x_ring(k:K ring))` [RING_POW] THEN
  have `ring_mul(x_ring k) h q IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) (ring_mul(x_ring k) h q) B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) b A IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) (x_minus_const k u) q IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) (ring_mul(x_ring k) (x_minus_const k u) q) B IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_sub(x_ring k) (ring_mul(x_ring k) (ring_mul(x_ring k) (x_minus_const k u) q) B) (ring_mul(x_ring k) b A) IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  have `ring_mul(x_ring k) h (ring_sub(x_ring k) (ring_mul(x_ring k) (ring_mul(x_ring k) (x_minus_const k u) q) B) (ring_mul(x_ring k) b A)) IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  simp[poly_shift_mul;poly_shift_pow;poly_shift_sub;x_then_pow_is_x_pow] THEN
  qed[RING_RULE `ring_mul(r:R ring) Y (ring_mul r h (ring_sub r (ring_mul r (ring_mul r X q) B) (ring_mul r b A))) = ring_sub r (ring_mul r (ring_mul r X Y) (ring_mul r (ring_mul r h q) B)) (ring_mul r Y (ring_mul r (ring_mul r h b) A))`;x_pow_in_x_ring;poly_shift_in_x_ring;RING_MUL;x_in_x_ring]
);;

let goppa_checking_2_XYlemma = prove(`
  !(k:K ring) t D R Q RQD barhqb barhq barhb barB RBD X Y.
  D IN ring_carrier(x_ring k) ==>
  R IN ring_carrier(x_ring k) ==>
  Q IN ring_carrier(x_ring k) ==>
  RQD IN ring_carrier(x_ring k) ==>
  barhqb IN ring_carrier(x_ring k) ==>
  barhq IN ring_carrier(x_ring k) ==>
  barhb IN ring_carrier(x_ring k) ==>
  barB IN ring_carrier(x_ring k) ==>
  RBD IN ring_carrier(x_ring k) ==>
  X IN ring_carrier(x_ring k) ==>
  Y IN ring_carrier(x_ring k) ==>
  barhqb = ring_mul(x_ring k) barhq barB ==>
  X = ring_sub(x_ring k)
        (ring_mul(x_ring k)
           (x_pow k (2*t))
           barhqb)
        (ring_mul(x_ring k)
           (x_pow k (2*t-1))
           (ring_mul(x_ring k) barhb D)) ==>
  ring_sub(x_ring k)
    (ring_mul(x_ring k) (x_pow k (2*t)) R)
    Q
  = ring_mul(x_ring k) D RQD ==>
  ring_sub(x_ring k) R barB
  = ring_mul(x_ring k) D RBD ==>
  Y = ring_sub(x_ring k)
        (ring_mul(x_ring k) barhq RQD)
        (ring_add(x_ring k)
           (ring_mul(x_ring k)
              (x_pow k (2*t-1))
              barhb)
           (ring_mul(x_ring k)
              (x_pow k (2*t))
              (ring_mul(x_ring k) barhq RBD)))
  ==>
  ring_sub(x_ring k) X (ring_mul(x_ring k) barhq Q)
  = ring_mul(x_ring k) D Y
`,
  intro THEN
  qed[RING_RULE `ring_sub r (ring_mul r T2 R) Q = ring_mul r D RQD ==> ring_sub r R barB = ring_mul r D RBD ==> ring_sub(r:R ring) (ring_sub r (ring_mul r T2 (ring_mul r barhq barB)) (ring_mul r T21 (ring_mul r barhb D))) (ring_mul r barhq Q) = ring_mul r D (ring_sub r (ring_mul r barhq RQD) (ring_add r (ring_mul r T21 barhb) (ring_mul r T2 (ring_mul r barhq RBD))))`;x_pow_in_x_ring]
);;

let goppa_checking_2_gqlemma = prove(`
  !(k:K ring) S r g q b G u.
  field k ==>
  ring_char k = 2 ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  (!s. s IN S ==> r s IN ring_carrier k) ==>
  (!s. s IN S ==> ring_pow k (r s) 2 = r s) ==>
  g IN ring_carrier(x_ring k) ==>
  q IN ring_carrier(x_ring k) ==>
  b IN ring_carrier(x_ring k) ==>
  G = ring_mul(x_ring k) g g ==>
  u IN S ==>
  poly_eval k u (ring_mul (x_ring k) g b)
  = ring_sum k S
      (\s. ring_mul k
             (ring_div k (r s) (poly_eval k s g))
             (poly_eval k s q)) ==>
  poly_eval k u (ring_mul(x_ring k) q b)
  = ring_sum k S
      (\s. ring_mul k
             (ring_div k (r s) (poly_eval k s G))
             (poly_eval k s (ring_mul(x_ring k) q q))) ==>
  ring_pow k (poly_eval k u (ring_mul(x_ring k) g b)) 2
  = poly_eval k u (ring_mul(x_ring k) q b)
`,
  intro THEN
  have `prime 2` [PRIME_2] THEN
  simp[] THEN
  have `!s:K. s IN S ==> ring_mul(k:K ring) (ring_div k (r s) (poly_eval k s g)) (poly_eval k s q) IN ring_carrier k` [RING_MUL;RING_DIV;poly_eval_in_ring] THEN
  specialize[`k:K ring`;`2`;`\s:K. ring_mul k (ring_div k (r s) (poly_eval k s g)) (poly_eval k s q)`;`S:K->bool`]freshman_binomial_theorem_sum THEN
  simp[] THEN
  simp[RING_MUL_POW;RING_DIV;poly_eval_in_ring] THEN
  have `!s:K. s IN S ==> s IN ring_carrier k` [SUBSET] THEN
  simp[poly_eval_mul;ring_div_pow;poly_eval_in_ring] THEN
  subgoal `!s:K. s IN S ==> ring_mul k (ring_div k (r s) (ring_pow k (poly_eval k s g) 2)) (ring_pow k (poly_eval k s q) 2) = ring_mul k (ring_div k (r s) (ring_mul k (poly_eval k s g) (poly_eval k s g))) (ring_mul k (poly_eval k s q) (poly_eval k s q))` THENL [
    intro THEN
    specialize_raw[`k:K ring`;`(r:K->K) s`;`poly_eval(k:K ring) s g`;`poly_eval(k:K ring) s q`]field_sq_div_as_mul_div THEN
    have `!s:K. s IN S ==> r s IN ring_carrier(k:K ring)` [RING_MUL;RING_DIV;poly_eval_in_ring] THEN
    qed[RING_MUL;RING_DIV;poly_eval_in_ring;field_sq_div_as_mul_div]
  ; pass
  ] THEN
  specialize[`k:K ring`;`\s:K. ring_mul k (ring_div k (r s) (ring_pow k (poly_eval k s g) 2)) (ring_pow k (poly_eval k s q) 2)`;`\s:K. ring_mul k (ring_div k (r s) (ring_mul k (poly_eval k s g) (poly_eval k s g))) (ring_mul k (poly_eval k s q) (poly_eval k s q))`;`S:K->bool`]RING_SUM_EQ THEN
  qed[]
);;

let goppa_checking_2_mainlemma = prove(`
  !(k:K ring) S g G A B t a b Aprime aprime aBbA e r u.
  field k ==>
  ring_char k = 2 ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  Aprime = x_derivative k A ==>
  g IN ring_carrier(x_ring k) ==>
  twodeg k g = 2 EXP t ==>
  G = ring_mul(x_ring k) g g ==>
  ring_coprime(x_ring k) (g,A) ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  aprime = x_derivative k a ==>
  b IN ring_carrier(x_ring k) ==>
  ring_coprime(x_ring k) (a,b) ==>
  twodeg k a <= 2 EXP t ==> 
  ring_divides(x_ring k) a A ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  2 EXP (2*t) * twodeg k aBbA < twodeg k A * twodeg k a ==>
  (!s. s IN S ==>
   r s = ring_div k
           (poly_eval k s (ring_mul(x_ring k) G B))
           (poly_eval k s Aprime)) ==>
  (!s. s IN S ==> ring_pow k (r s) 2 = r s) ==>
  (!s. s IN S ==>
       e s = if poly_eval k s a = ring_0 k then ring_1 k
             else ring_0 k) ==>
  u IN S ==>
  poly_eval k u a = ring_0 k ==>
  poly_eval k u (ring_mul(x_ring k) G b)
  = poly_eval k u aprime
`,
  intro THEN
  have `integral_domain(k:K ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `u IN ring_carrier(k:K ring)` [SUBSET] THEN
  choose `q:(num->num)->K` `q IN ring_carrier(x_ring(k:K ring)) /\ a = ring_mul(x_ring k) (x_minus_const k u) q` [ring_divides;x_minus_const_divides_if_root] THEN
  subgoal `poly_eval(k:K ring) u q = poly_eval k u aprime` THENL [
    have `poly_eval(k:K ring) u (x_derivative k a) = ring_mul k (poly_eval k u (x_derivative k (x_minus_const k u))) (poly_eval k u q)` [x_derivative_bernoulli_rule;x_minus_const_in_x_ring;eval_x_minus_const;RING_SUB_REFL] THEN
    have `poly_eval k u (x_derivative(k:K ring) (x_minus_const k u)) = ring_1 k` [x_derivative_x_minus_const;poly_eval_1] THEN
    qed[ring_1_mul;poly_eval_in_ring]
  ; pass
  ] THEN
  def `Z:K->bool` `{z:K | z IN ring_carrier k /\ ring_add k z u IN S}` THEN
  def `D:(num->num)->K` `monic_vanishing_at(k:K ring) Z` THEN
  have `poly_shift (k:K ring) u A = D` [poly_shift_monic_vanishing_at] THEN
  def `Dprime:(num->num)->K` `x_derivative(k:K ring) D` THEN
  have `Dprime = poly_shift(k:K ring) u Aprime` [x_derivative_poly_shift;monic_vanishing_at_in_x_ring] THEN
  def `R:(num->num)->K` `ring_sum(x_ring(k:K ring)) Z (\z. ring_mul(x_ring k) (poly_const k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime))) (monic_vanishing_at_except k Z z))` THEN
  subgoal `!z. z IN Z ==> poly_eval(k:K ring) z R = poly_eval k z (poly_shift k u B)` THENL [
    intro THEN
    set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
    have `Z SUBSET ring_carrier(k:K ring)` [SUBSET] THEN
    have `z IN ring_carrier(k:K ring)` [] THEN
    have `poly_eval(k:K ring) z (poly_shift k u B) = poly_eval k (ring_add k z u) B` [poly_eval_shift] THEN
    have `poly_eval(k:K ring) z D = poly_eval k (ring_add k z u) A` [poly_eval_shift;monic_vanishing_at_in_x_ring] THEN
    have `FINITE(Z:K->bool)` [subset_shift_finite] THEN
    specialize_raw[`k:K ring`;`Z:K->bool`;`\z:K. ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)`;`z:K`]eval_sum_monic_vanishing_at_except THEN
    have `poly_eval(k:K ring) (ring_add k z u) B IN ring_carrier k` [poly_eval_in_ring;RING_ADD] THEN
    have `poly_eval(k:K ring) z R = ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (monic_vanishing_at_except k Z z))` [RING_DIV;poly_eval_in_ring] THEN
    have `poly_eval(k:K ring) z Dprime = poly_eval k z (monic_vanishing_at_except k Z z)` [eval_derivative_monic_vanishing_at] THEN
    have `poly_eval k z (monic_vanishing_at_except k Z z) IN ring_carrier(k:K ring)` [monic_vanishing_at_except_in_x_ring;poly_eval_in_ring] THEN
    have `~(poly_eval k z (monic_vanishing_at_except k Z z) = ring_0(k:K ring))` [eval_monic_vanishing_at_except_nonzero] THEN
    specialize[`k:K ring`;`poly_eval(k:K ring) (ring_add k z u) B`;`poly_eval(k:K ring) z (monic_vanishing_at_except k Z z)`]field_div_mul_cancel THEN
    have `ring_mul(k:K ring) (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (monic_vanishing_at_except k Z z)) = poly_eval k (ring_add k z u) B` [] THEN
    have `poly_eval(k:K ring) z R = poly_eval k (ring_add k z u) B` [] THEN
    qed[]
  ; pass
  ] THEN
  subgoal `!z. z IN Z ==> poly_eval(k:K ring) z (ring_sub(x_ring k) R (poly_shift k u B)) = ring_0 k` THENL [
    intro THEN
    set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
    have `Z SUBSET ring_carrier(k:K ring)` [SUBSET] THEN
    have `z IN ring_carrier(k:K ring)` [] THEN
    have `poly_shift(k:K ring) u B IN ring_carrier(x_ring k)` [poly_shift_in_x_ring] THEN
    have `R IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
    simp[poly_eval_sub] THEN
    qed[RING_SUB_REFL;poly_eval_in_ring]
  ; pass
  ] THEN
  subgoal `ring_divides(x_ring(k:K ring)) D (ring_sub(x_ring k) R (poly_shift k u B))` THENL [
    set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
    have `Z SUBSET ring_carrier(k:K ring)` [SUBSET] THEN
    have `FINITE(Z:K->bool)` [subset_shift_finite] THEN
    specialize_raw[`k:K ring`;`Z:K->bool`;`ring_sub(x_ring(k:K ring)) R (poly_shift k u B)`]monic_vanishing_at_divides_if_roots THEN
    qed[RING_SUB;RING_SUM;poly_shift_in_x_ring]
  ; pass
  ] THEN
  def `Q:(num->num)->K` `ring_sum(x_ring(k:K ring)) Z (\z. ring_mul(x_ring k) (poly_const k (ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (ring_pow k z (2*t)))) (monic_vanishing_at_except k Z z))` THEN
  def `RQD:(num->num)->K` `ring_sum(x_ring(k:K ring)) {d | d < 2*t} (\d. const_x_pow k (ring_sum k Z (\z. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (ring_pow k z (2*t-1-d)))) d)` THEN
  subgoal `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) (x_pow k (2*t)) R) Q = ring_mul(x_ring k) D RQD` THENL [
    set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
    have `Z SUBSET ring_carrier(k:K ring)` [SUBSET] THEN
    have `FINITE(Z:K->bool)` [subset_shift_finite] THEN
    have `!z:K. z IN Z ==> ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime) IN ring_carrier(k:K ring)` [RING_DIV;poly_eval_in_ring;RING_ADD] THEN
    specialize[`k:K ring`;`Z:K->bool`;`\z:K. ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)`;`2*t`]goppa_parity_lemma THEN
    qed[]
  ; pass
  ] THEN
  subgoal `!f. f IN ring_carrier(x_ring(k:K ring)) ==> twodeg k f < 2 EXP (2*t) ==> coeff (2*t-1) (ring_mul(x_ring k) f RQD) = ring_sum k Z (\z. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z f))` THENL [
    intro THEN
    specialize_raw[`k:K ring`;`Z:K->bool`;`\z:K. z`;`f:(num->num)->K`;`2*t`;`\z. ring_div(k:K ring) (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)`]sum_poly_eval_as_coeff_sum THEN
    set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
    have `FINITE(Z:K->bool)` [subset_shift_finite] THEN
    qed[RING_DIV;poly_eval_in_ring;RING_ADD]
  ; pass
  ] THEN
  subgoal `!h. h IN ring_carrier(x_ring(k:K ring)) ==> twodeg k h <= 2 EXP t ==> twodeg k (poly_shift k u (ring_mul(x_ring k) h q)) < 2 EXP(2*t)` THENL [
    intro THEN
    have `twodeg(k:K ring) a = twodeg k (x_minus_const k u) * twodeg k q` [twodeg_mul;x_minus_const_in_x_ring] THEN
    have `twodeg(k:K ring) (x_minus_const k u) = 2 EXP 1` [twodeg_x_minus_const;integral_domain] THEN
    have `twodeg(k:K ring) a = 2 EXP 1 * twodeg k q` [] THEN
    ASM_CASES_TAC `twodeg(k:K ring) q < 2 EXP t` THENL [
      have `twodeg(k:K ring) (ring_mul(x_ring k) h q) = twodeg k h * twodeg k q` [twodeg_mul] THEN
      have `twodeg(k:K ring) h * twodeg k q <= 2 EXP t * twodeg k q` [LE_MULT2;LE_REFL] THEN
      have `2 EXP t * twodeg(k:K ring) q < 2 EXP t * 2 EXP t` [LT_LMULT;twopow_nonzero] THEN
      have `2 EXP t * twodeg(k:K ring) q < 2 EXP (2*t)` [EXP_ADD;ARITH_RULE `2*t = t+t`] THEN
      have `twodeg(k:K ring) (poly_shift k u (ring_mul(x_ring k) h q)) <= twodeg k (ring_mul(x_ring k) h q)` [twodeg_poly_shift_le;RING_MUL] THEN
      qed[LET_TRANS]
    ;
      num_linear `~(twodeg(k:K ring) q < 2 EXP t) ==> 2 EXP t <= twodeg k q` THEN
      have `2 EXP 1 * 2 EXP t <= twodeg(k:K ring) a` [LE_MULT2;LE_REFL] THEN
      have `2 EXP (1+t) <= 2 EXP t` [EXP_ADD;LE_TRANS] THEN
      have `1+t <= t` [twopow_mono_le] THEN
      ASM_ARITH_TAC
    ]
  ; pass
  ] THEN
  subgoal `!h. h IN ring_carrier(x_ring(k:K ring)) ==> twodeg k h <= 2 EXP t ==> coeff (2*t-1) (ring_mul(x_ring k) (poly_shift k u (ring_mul(x_ring k) h q)) RQD) = ring_sum k S (\s. ring_mul k (ring_div k (poly_eval k s B) (poly_eval k s Aprime)) (poly_eval k s (ring_mul(x_ring k) h q)))` THENL [
    intro THEN
    have `twodeg(k:K ring) (poly_shift k u (ring_mul(x_ring k) h q)) < 2 EXP(2*t)` [] THEN
    have `coeff (2 * t - 1) (ring_mul (x_ring(k:K ring)) (poly_shift k u (ring_mul (x_ring k) h q)) RQD) = ring_sum k Z (\z. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q))))` [poly_shift_in_x_ring;RING_MUL] THEN
    subgoal `ring_sum(k:K ring) S (\s. ring_mul k (ring_div k (poly_eval k s B) (poly_eval k s Aprime)) (poly_eval k s (ring_mul (x_ring k) h q))) = ring_sum k Z (\z. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q))))` THENL [
      def `f:K->K` `\s:K. ring_sub k s u` THEN
      have `!x y:K. x IN S ==> y IN S ==> f x = f y:K ==> x = y` [RING_RULE `ring_sub(r:R ring) x c = ring_sub r y c ==> x = y`;SUBSET] THEN
      subgoal `ring_sum(k:K ring) Z (\z:K. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q)))) = ring_sum k S (\z:K. ring_mul k (ring_div k (poly_eval k (ring_add k (f z) u) B) (poly_eval k (f (z:K)) Dprime)) (poly_eval k (f z) (poly_shift k u (ring_mul (x_ring k) h q))))` THENL [
        specialize[`k:K ring`;`f:K->K`;`\z:K. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q)))`;`S:K->bool`]RING_SUM_IMAGE THEN
        have `IMAGE (f:K->K) S = Z` [subset_shift_image] THEN
        have `ring_sum(k:K ring) Z (\z:K. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q)))) = ring_sum k S ((\z:K. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q)))) o (f:K->K))` [] THEN
        subgoal `!s:K. s IN S ==> ((\z:K. ring_mul(k:K ring) (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q)))) o f) s = (\z:K. ring_mul(k:K ring) (ring_div k (poly_eval k (ring_add k (f z) u) B) (poly_eval k (f z) Dprime)) (poly_eval k (f z) (poly_shift k u (ring_mul (x_ring k) h q)))) s` THENL [
          rw[o_THM]
        ; pass
        ] THEN
        specialize_raw[`k:K ring`;`(\z:K. ring_mul(k:K ring) (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (poly_eval k z (poly_shift k u (ring_mul (x_ring k) h q)))) o (f:K->K)`;`(\z:K. ring_mul(k:K ring) (ring_div k (poly_eval k (ring_add k (f z) u) B) (poly_eval k (f z) Dprime)) (poly_eval k (f z) (poly_shift k u (ring_mul (x_ring k) h q))))`;`S:K->bool`]RING_SUM_EQ THEN
        qed[]
      ; pass
      ] THEN
      subgoal `!s:K. s IN S ==> ring_mul (k:K ring) (ring_div k (poly_eval k (ring_add k (f s) u) B) (poly_eval k (f s) Dprime)) (poly_eval k (f s) (poly_shift k u (ring_mul (x_ring k) h q))) = ring_mul k (ring_div k (poly_eval k s B) (poly_eval k s Aprime)) (poly_eval k s (ring_mul (x_ring k) h q))` THENL [
        intro THEN
        have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
        have `ring_add(k:K ring) (f (s:K)) u = s` [ring_sub_add_cancel] THEN
        have `Aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring;monic_vanishing_at_in_x_ring] THEN
        have `f (s:K) IN ring_carrier(k:K ring)` [RING_SUB] THEN
        have `poly_eval(k:K ring) (f (s:K)) Dprime = poly_eval k s Aprime` [poly_eval_shift] THEN
        have `poly_eval(k:K ring) (f (s:K)) (poly_shift k u (ring_mul (x_ring k) h q)) = poly_eval k s (ring_mul(x_ring k) h q)` [poly_eval_shift;RING_MUL] THEN
        qed[]
      ; pass
      ] THEN
      specialize[`k:K ring`;`\s:K. ring_mul (k:K ring) (ring_div k (poly_eval k (ring_add k (f s) u) B) (poly_eval k (f s) Dprime)) (poly_eval k (f s) (poly_shift k u (ring_mul (x_ring k) h q)))`;`\s:K. ring_mul k (ring_div k (poly_eval k s B) (poly_eval k s Aprime)) (poly_eval k s (ring_mul (x_ring k) h q))`;`S:K->bool`]RING_SUM_EQ THEN
      qed[]
    ; pass
    ] THEN
    qed[]
  ; pass
  ] THEN
  subgoal `~(t = 0)` THENL [
    have `twodeg(k:K ring) a = twodeg k (x_minus_const k u) * twodeg k q` [twodeg_mul;x_minus_const_in_x_ring] THEN
    have `twodeg(k:K ring) (x_minus_const k u) = 2 EXP 1` [twodeg_x_minus_const;integral_domain] THEN
    have `twodeg(k:K ring) a = 2 EXP 1 * twodeg k q` [] THEN
    have `~(twodeg(k:K ring) a = 0)` [twodeg_only_0;nonzero_if_divides_monic_vanishing_at] THEN
    have `1 <= twodeg(k:K ring) q` [ARITH_RULE `~(1 <= q) ==> 2 EXP 1 * q = 0`] THEN
    have `2 EXP 1 <= twodeg(k:K ring) a` [ARITH_RULE `1 <= q ==> 2 EXP 1 <= 2 EXP 1 * q`] THEN
    have `2 EXP 1 <= 2 EXP t` [LE_TRANS] THEN
    have `1 <= t` [twopow_mono_le] THEN
    ASM_ARITH_TAC
  ; pass
  ] THEN
  subgoal `!h. h IN ring_carrier(x_ring(k:K ring)) ==> twodeg k h <= 2 EXP t ==> coeff (2*t-1) (ring_mul(x_ring k) (poly_shift k u (ring_mul(x_ring k) h q)) RQD) = poly_eval k u (ring_mul(x_ring k) h b)` THENL [
    intro THEN
    def `X:(num->num)->K` `ring_sub(x_ring(k:K ring))
      (ring_mul(x_ring k) (x_pow k (2*t)) (poly_shift k u (ring_mul(x_ring k) (ring_mul(x_ring k) h q) B)))
      (ring_mul(x_ring k) (x_pow k (2*t-1)) (ring_mul(x_ring k) (poly_shift k u (ring_mul(x_ring k) h b)) D))
    ` THEN
    subgoal `twodeg(k:K ring) X < 2 EXP (2*t-1) * twodeg k A` THENL [
      have `aBbA IN ring_carrier(x_ring(k:K ring))` [RING_SUB;RING_MUL;monic_vanishing_at_in_x_ring] THEN
      subgoal `twodeg(k:K ring) (ring_mul(x_ring k) h aBbA) < twodeg k A` THENL [
        have `2 EXP t * (2 EXP t * twodeg k aBbA) < twodeg(k:K ring) A * twodeg k a` [ARITH_RULE `2 EXP t * (2 EXP t * H) = (2 EXP t * 2 EXP t) * H`;EXP_ADD;ARITH_RULE `2*t=t+t`] THEN
        have `twodeg(k:K ring) A * twodeg k a <= 2 EXP t * twodeg k A` [LE_MULT2;LE_REFL;MULT_SYM] THEN
        have `2 EXP t * (2 EXP t * twodeg(k:K ring) aBbA) < 2 EXP t * twodeg k A` [LTE_TRANS] THEN
        have `2 EXP t * twodeg(k:K ring) aBbA < twodeg k A` [LT_MULT_LCANCEL] THEN
        have `twodeg(k:K ring) (ring_mul(x_ring k) h aBbA) = twodeg k h * twodeg k aBbA` [twodeg_mul] THEN
        have `twodeg(k:K ring) (ring_mul(x_ring k) h aBbA) <= 2 EXP t * twodeg k aBbA` [LE_MULT2;LE_REFL] THEN
        qed[LET_TRANS]
      ; pass
      ] THEN
      have `twodeg(k:K ring) (x_minus_const k u) = 2` [twodeg_x_minus_const;integral_domain;ARITH_RULE `2 EXP 1 = 2`] THEN
      have `twodeg(k:K ring) (ring_pow(x_ring k) (x_minus_const k u) (2*t-1)) = 2 EXP (2*t-1)` [twodeg_pow;x_minus_const_in_x_ring] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) (ring_pow(x_ring k) (x_minus_const k u) (2*t-1)) (ring_mul(x_ring k) h aBbA)) = 2 EXP (2*t-1) * twodeg k (ring_mul(x_ring k) h aBbA)` [twodeg_mul;x_minus_const_in_x_ring;RING_POW;RING_MUL] THEN
      have `2 EXP (2*t-1) * twodeg k (ring_mul(x_ring k) h aBbA) < 2 EXP (2*t-1) * twodeg(k:K ring) A` [LT_LMULT;twopow_nonzero] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) (ring_pow(x_ring k) (x_minus_const k u) (2*t-1)) (ring_mul(x_ring k) h aBbA)) < 2 EXP (2*t-1) * twodeg k A` [] THEN
      have `poly_shift(k:K ring) u (ring_mul(x_ring k) (ring_pow(x_ring k) (x_minus_const k u) (2*t-1)) (ring_mul(x_ring k) h aBbA)) = X` [goppa_checking_2_barlemma;monic_vanishing_at_in_x_ring] THEN
      have `ring_mul(x_ring k) (ring_pow(x_ring k) (x_minus_const k u) (2*t-1)) (ring_mul(x_ring k) h aBbA) IN ring_carrier(x_ring(k:K ring))` [RING_MUL;RING_POW;x_minus_const_in_x_ring] THEN
      have `twodeg(k:K ring) X <= twodeg k (ring_mul(x_ring k) (ring_pow(x_ring k) (x_minus_const k u) (2*t-1)) (ring_mul(x_ring k) h aBbA))` [twodeg_poly_shift_le] THEN
      qed[LET_TRANS]
    ; pass
    ] THEN
    subgoal `twodeg(k:K ring) (ring_mul(x_ring k) (poly_shift k u (ring_mul(x_ring k) h q)) Q) < 2 EXP (2*t-1) * twodeg k A` THENL [
      set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
      have `Z SUBSET ring_carrier(k:K ring)` [SUBSET] THEN
      have `FINITE(Z:K->bool)` [subset_shift_finite] THEN
      have `!z:K. z IN Z ==> ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (ring_pow k z (2 * t)) IN ring_carrier k` [RING_MUL;RING_DIV;poly_eval_in_ring;RING_ADD;RING_POW] THEN
      specialize[`k:K ring`;`Z:K->bool`;`\z:K. ring_mul k (ring_div k (poly_eval k (ring_add k z u) B) (poly_eval k z Dprime)) (ring_pow k z (2 * t))`]twodeg_sum_monic_vanishing_at_except THEN
      have `twodeg(k:K ring) Q < 2 EXP CARD(Z:K->bool)` [] THEN
      have `twodeg(k:K ring) Q < 2 EXP CARD(S:K->bool)` [subset_shift_card] THEN
      have `twodeg(k:K ring) Q < twodeg k A` [twodeg_monic_vanishing_at] THEN
      have `twodeg(k:K ring) (poly_shift k u (ring_mul(x_ring k) h q)) < 2 EXP(2*t)` [] THEN
      have `twodeg(k:K ring) (poly_shift k u (ring_mul(x_ring k) h q)) <= 2 EXP(2*t-1)` [twodeg_le_half_if_lt] THEN
      have `twodeg(k:K ring) (poly_shift k u (ring_mul(x_ring k) h q)) * twodeg k Q <= 2 EXP(2*t-1) * twodeg k Q` [LE_MULT2;LE_REFL] THEN
      have `2 EXP(2*t-1) * twodeg(k:K ring) Q < 2 EXP(2*t-1) * twodeg k A` [LT_LMULT;twopow_nonzero] THEN
      qed[LET_TRANS;twodeg_mul;RING_MUL;poly_shift_in_x_ring;RING_SUM]
    ; pass
    ] THEN
    have `poly_shift(k:K ring) u (ring_mul (x_ring k) (ring_mul (x_ring k) h q) B) = ring_mul(x_ring k) (poly_shift k u (ring_mul(x_ring k) h q)) (poly_shift k u B)` [poly_shift_mul;RING_MUL] THEN
    choose `RBD:(num->num)->K` `RBD IN ring_carrier(x_ring(k:K ring)) /\ ring_sub(x_ring k) R (poly_shift k u B) = ring_mul(x_ring k) D RBD` [ring_divides] THEN
    def `Y:(num->num)->K` `ring_sub (x_ring(k:K ring)) (ring_mul (x_ring k) (poly_shift k u (ring_mul(x_ring k) h q)) RQD) (ring_add (x_ring k) (ring_mul (x_ring k) (x_pow k (2 * t - 1)) (poly_shift k u (ring_mul(x_ring k) h b))) (ring_mul (x_ring k) (x_pow k (2 * t)) (ring_mul (x_ring k) (poly_shift k u (ring_mul(x_ring k) h q)) RBD)))` THEN
    have `RQD IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
    have `Y IN ring_carrier(x_ring(k:K ring))` [RING_SUB;RING_ADD;RING_MUL;x_pow_in_x_ring;poly_shift_in_x_ring] THEN
    subgoal `ring_sub (x_ring(k:K ring)) X (ring_mul (x_ring k) (poly_shift k u (ring_mul (x_ring k) h q)) Q) = ring_mul (x_ring k) D Y` THENL [
      have `D IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
      have `R IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
      have `Q IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
      have `poly_shift k u (ring_mul(x_ring k) (ring_mul(x_ring k) h q) B) IN ring_carrier(x_ring(k:K ring))` [poly_shift_in_x_ring;RING_MUL] THEN
      have `poly_shift k u (ring_mul(x_ring k) h q) IN ring_carrier(x_ring(k:K ring))` [poly_shift_in_x_ring;RING_MUL] THEN
      have `poly_shift k u (ring_mul(x_ring k) h b) IN ring_carrier(x_ring(k:K ring))` [poly_shift_in_x_ring;RING_MUL] THEN
      have `poly_shift k u B IN ring_carrier(x_ring(k:K ring))` [poly_shift_in_x_ring] THEN
      have `RQD IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
      have `RBD IN ring_carrier(x_ring(k:K ring))` [] THEN
      have `X IN ring_carrier(x_ring(k:K ring))` [RING_SUB;RING_MUL;x_pow_in_x_ring;poly_shift_in_x_ring] THEN
      have `ring_sub (x_ring(k:K ring)) R (poly_shift k u B) = ring_mul (x_ring k) D RBD` [] THEN
      specialize[`k:K ring`;`t:num`;`D:(num->num)->K`;`R:(num->num)->K`;`Q:(num->num)->K`;`RQD:(num->num)->K`;`poly_shift(k:K ring) u (ring_mul(x_ring k) (ring_mul(x_ring k) h q) B)`;`poly_shift(k:K ring) u (ring_mul(x_ring k) h q)`;`poly_shift(k:K ring) u (ring_mul(x_ring k) h b)`;`poly_shift(k:K ring) u B`;`RBD:(num->num)->K`;`X:(num->num)->K`;`Y:(num->num)->K`]goppa_checking_2_XYlemma THEN
      qed[]
    ; pass
    ] THEN
    subgoal `twodeg(k:K ring) Y < 2 EXP (2*t-1)` THENL [
      have `D IN ring_carrier(x_ring(k:K ring))` [monic_vanishing_at_in_x_ring] THEN
      have `RBD IN ring_carrier(x_ring(k:K ring))` [] THEN
      have `X IN ring_carrier(x_ring(k:K ring))` [RING_SUB;RING_MUL;x_pow_in_x_ring;poly_shift_in_x_ring] THEN
      have `Q IN ring_carrier(x_ring(k:K ring))` [RING_SUM] THEN
      have `twodeg(k:K ring) (ring_sub (x_ring k) X (ring_mul (x_ring k) (poly_shift k u (ring_mul (x_ring k) h q)) Q)) < 2 EXP (2*t-1) * twodeg k A` [twodeg_sub_lt;poly_shift_in_x_ring;RING_MUL] THEN
      have `twodeg(k:K ring) (ring_mul(x_ring k) D Y) < 2 EXP (2*t-1) * twodeg k A` [] THEN
      have `twodeg(k:K ring) D * twodeg k Y < 2 EXP (2*t-1) * twodeg k A` [twodeg_mul] THEN
      set_tac `!y. y IN {z:K | z IN ring_carrier k /\ ring_add k z u IN S} ==> y IN ring_carrier(k:K ring)` [] THEN
      have `Z SUBSET ring_carrier(k:K ring)` [SUBSET] THEN
      have `FINITE(Z:K->bool)` [subset_shift_finite] THEN
      have `twodeg(k:K ring) D = 2 EXP CARD(Z:K->bool)` [twodeg_monic_vanishing_at] THEN
      have `twodeg(k:K ring) A = 2 EXP CARD(S:K->bool)` [twodeg_monic_vanishing_at] THEN
      have `CARD(Z:K->bool) = CARD(S:K->bool)` [subset_shift_card] THEN
      have `twodeg(k:K ring) D = 2 EXP CARD(S:K->bool)` [] THEN
      have `twodeg(k:K ring) D = twodeg k A` [] THEN
      have `twodeg(k:K ring) A * twodeg k Y < twodeg k A * 2 EXP (2*t-1)` [MULT_SYM] THEN
      qed[LT_MULT_LCANCEL]
    ; pass
    ] THEN
    have `coeff(2*t-1) Y = ring_0(k:K ring)` [support_le_twodeg;NOT_LT] THEN
    have `coeff(2*t-1) (ring_mul (x_ring(k:K ring)) (poly_shift k u (ring_mul (x_ring k) h q)) RQD) = coeff(2*t-1) (ring_add (x_ring k) (ring_mul (x_ring k) (x_pow k (2 * t - 1)) (poly_shift k u (ring_mul (x_ring k) h b))) (ring_mul (x_ring k) (x_pow k (2 * t)) (ring_mul (x_ring k) (poly_shift k u (ring_mul (x_ring k) h q)) RBD)))` [coeff_sub_eq_0;RING_MUL;poly_shift_in_x_ring;RING_ADD;x_pow_in_x_ring;poly_shift_in_x_ring] THEN
    have `coeff(2*t-1) (ring_mul (x_ring(k:K ring)) (poly_shift k u (ring_mul (x_ring k) h q)) RQD) = ring_add k (coeff(2*t-1) (ring_mul (x_ring k) (x_pow k (2 * t - 1)) (poly_shift k u (ring_mul (x_ring k) h b)))) (coeff(2*t-1) (ring_mul (x_ring k) (x_pow k (2 * t)) (ring_mul (x_ring k) (poly_shift k u (ring_mul (x_ring k) h q)) RBD)))` [coeff_add;RING_MUL;poly_shift_in_x_ring;x_pow_in_x_ring;poly_shift_in_x_ring] THEN
    have `coeff(2*t-1) (ring_mul (x_ring(k:K ring)) (x_pow k (2 * t)) (ring_mul (x_ring k) (poly_shift k u (ring_mul (x_ring k) h q)) RBD)) = ring_0(k:K ring)` [coeff_x_pow_times_lt;poly_shift_in_x_ring;RING_MUL;ARITH_RULE `~(t = 0) ==> 2*t-1 < 2*t`] THEN
    have `coeff(2*t-1) (ring_mul (x_ring(k:K ring)) (x_pow k (2 * t - 1)) (poly_shift k u (ring_mul (x_ring k) h b))) = coeff 0 (poly_shift k u (ring_mul (x_ring k) h b))` [coeff_x_pow_times;poly_shift_in_x_ring;RING_MUL;ARITH_RULE `2*t-1 = (2*t-1+0)`] THEN
    have `coeff 0 (poly_shift(k:K ring) u (ring_mul (x_ring k) h b)) = poly_eval k u (ring_mul(x_ring k) h b)` [poly_eval_at_0;RING_MUL;poly_eval_shift;ring_0_add;poly_shift_in_x_ring;RING_0] THEN
    have `coeff(2*t-1) (ring_mul (x_ring(k:K ring)) (poly_shift k u (ring_mul (x_ring k) h q)) RQD) = ring_add k (poly_eval k u (ring_mul(x_ring k) h b)) (ring_0 k)` [] THEN
    qed[ring_add_0;RING_MUL;poly_eval_in_ring]
  ; pass
  ] THEN
  have `!h. h IN ring_carrier(x_ring(k:K ring)) ==> twodeg k h <= 2 EXP t ==> poly_eval k u (ring_mul(x_ring k) h b) = ring_sum k S (\s. ring_mul k (ring_div k (poly_eval k s B) (poly_eval k s Aprime)) (poly_eval k s (ring_mul(x_ring k) h q)))` [] THEN
  subgoal `!h. h IN ring_carrier(x_ring(k:K ring)) ==> twodeg k h <= 2 EXP t ==> poly_eval k u (ring_mul(x_ring k) h b) = ring_sum k S (\s. ring_mul k (ring_div k (r s) (poly_eval k s G)) (poly_eval k s (ring_mul(x_ring k) h q)))` THENL [
    intro THEN
    subgoal `!s. s IN S ==> ring_div(k:K ring) (r s) (poly_eval k s G) = ring_div k (poly_eval k s B) (poly_eval k s Aprime)` THENL [
      intro THEN
      have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
      have `poly_eval(k:K ring) s G = ring_mul k (poly_eval k s g) (poly_eval k s g)` [poly_eval_mul] THEN
      have `poly_eval(k:K ring) s A = ring_0 k` [monic_vanishing_at_vanishes] THEN
      have `~(poly_eval(k:K ring) s g = ring_0 k)` [not_coprime_if_shared_root;monic_vanishing_at_in_x_ring] THEN
      have `~(poly_eval(k:K ring) s G = ring_0 k)` [integral_domain;poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s (ring_mul(x_ring k) G B) = ring_mul k (poly_eval k s G) (poly_eval k s B)` [poly_eval_mul;RING_MUL] THEN
      have `poly_eval k s G IN ring_carrier(k:K ring)` [poly_eval_in_ring;RING_MUL] THEN
      have `poly_eval k s B IN ring_carrier(k:K ring)` [poly_eval_in_ring] THEN
      have `poly_eval k s Aprime IN ring_carrier(k:K ring)` [poly_eval_in_ring;x_derivative_in_x_ring;monic_vanishing_at_in_x_ring] THEN
      specialize[`k:K ring`;`poly_eval(k:K ring) s G`;`poly_eval(k:K ring) s B`;`poly_eval(k:K ring) s Aprime`]field_mul_div_div_cancel THEN
      have `r s = ring_div(k:K ring) (ring_mul k (poly_eval k s G) (poly_eval k s B)) (poly_eval k s Aprime)` [] THEN
      qed[]
    ; pass
    ] THEN
    specialize_raw[`k:K ring`;`\s:K. ring_mul k (ring_div k (poly_eval k s B) (poly_eval k s Aprime)) (poly_eval k s (ring_mul (x_ring k) h q))`;`\s:K. ring_mul k (ring_div k (r s) (poly_eval k s G)) (poly_eval k s (ring_mul (x_ring k) h q))`]RING_SUM_EQ THEN
    qed[]
  ; pass
  ] THEN
  subgoal `poly_eval(k:K ring) u (ring_mul (x_ring k) g b) = ring_sum k S (\s:K. ring_mul k (ring_div k (r s) (poly_eval k s g)) (poly_eval k s q))` THENL [
    have `twodeg(k:K ring) g <= 2 EXP t` [ARITH_RULE `2 EXP t <= 2 EXP t`] THEN
    have `poly_eval(k:K ring) u (ring_mul (x_ring k) g b) = ring_sum k S (\s:K. ring_mul k (ring_div k (r s) (poly_eval k s G)) (poly_eval k s (ring_mul (x_ring k) g q)))` [] THEN
    subgoal `!s:K. s IN S ==> ring_mul k (ring_div k (r s) (poly_eval k s G)) (poly_eval k s (ring_mul (x_ring k) g q)) = ring_mul k (ring_div k (r s) (poly_eval k s g)) (poly_eval k s q)` THENL [
      intro THEN
      have `s IN ring_carrier(k:K ring)` [SUBSET] THEN
      have `poly_eval(k:K ring) s G = ring_mul k (poly_eval k s g) (poly_eval k s g)` [poly_eval_mul] THEN
      have `poly_eval(k:K ring) s A = ring_0 k` [monic_vanishing_at_vanishes] THEN
      have `~(poly_eval(k:K ring) s g = ring_0 k)` [not_coprime_if_shared_root;monic_vanishing_at_in_x_ring] THEN
      have `~(poly_eval(k:K ring) s G = ring_0 k)` [integral_domain;poly_eval_in_ring] THEN
      have `poly_eval(k:K ring) s (ring_mul(x_ring k) g q) = ring_mul k (poly_eval k s g) (poly_eval k s q)` [poly_eval_mul;RING_MUL] THEN
      have `(r:K->K) s IN ring_carrier k` [RING_DIV;RING_MUL;poly_eval_in_ring] THEN
      specialize_raw[`k:K ring`;`(r:K->K) s`;`poly_eval(k:K ring) s g`;`poly_eval(k:K ring) s q`]field_div_sq_mul_cancel THEN
      qed[poly_eval_in_ring]
    ; pass
    ] THEN
    specialize[`k:K ring`;`\s:K. ring_mul k (ring_div k (r s) (poly_eval k s G)) (poly_eval k s (ring_mul (x_ring k) g q))`;`\s:K. ring_mul k (ring_div k (r s) (poly_eval k s g)) (poly_eval k s q)`;`S:K->bool`]RING_SUM_EQ THEN
    qed[]
  ; pass
  ] THEN
  subgoal `poly_eval(k:K ring) u (ring_mul (x_ring k) q b) = ring_sum k S (\s:K. ring_mul k (ring_div k (r s) (poly_eval k s G)) (poly_eval k s (ring_mul (x_ring k) q q)))` THENL [
    have `twodeg(k:K ring) a = twodeg k (x_minus_const k u) * twodeg k q` [twodeg_mul;x_minus_const_in_x_ring] THEN
    have `twodeg(k:K ring) (x_minus_const k u) = 2 EXP 1` [twodeg_x_minus_const;integral_domain] THEN
    have `twodeg(k:K ring) a = 2 EXP 1 * twodeg k q` [] THEN
    have `twodeg(k:K ring) q <= 2 EXP t` [ARITH_RULE `2 EXP 1 * Q <= H ==> Q <= H`] THEN
    qed[]
  ; pass
  ] THEN
  subgoal `ring_pow(k:K ring) (poly_eval k u (ring_mul (x_ring k) g b)) 2 = poly_eval k u (ring_mul (x_ring k) q b)` THENL [
    have `!s:K. s IN S ==> r s IN ring_carrier(k:K ring)` [RING_MUL;RING_DIV;poly_eval_in_ring] THEN
    specialize_raw[`k:K ring`;`S:K->bool`;`r:K->K`;`g:(num->num)->K`;`q:(num->num)->K`;`b:(num->num)->K`;`G:(num->num)->K`;`u:K`]goppa_checking_2_gqlemma THEN
    qed[]
  ; pass
  ] THEN
  have `poly_eval(k:K ring) u (ring_mul(x_ring k) g b) = ring_mul k (poly_eval k u g) (poly_eval k u b)` [poly_eval_mul] THEN
  have `ring_pow(k:K ring) (ring_mul k (poly_eval k u g) (poly_eval k u b)) 2 = ring_mul k (ring_mul k (ring_mul k (poly_eval k u g) (poly_eval k u g)) (poly_eval k u b)) (poly_eval k u b)` [RING_RULE `ring_pow(k:K ring) (ring_mul k g b) 2 = ring_mul k (ring_mul k (ring_mul k g g) b) b`;poly_eval_in_ring] THEN
  have `poly_eval(k:K ring) u (ring_mul (x_ring k) q b) = ring_mul k (poly_eval k u q) (poly_eval k u b)` [poly_eval_mul] THEN
  have `ring_mul(k:K ring) (ring_mul k (ring_mul k (poly_eval k u g) (poly_eval k u g)) (poly_eval k u b)) (poly_eval k u b) = ring_mul k (poly_eval k u q) (poly_eval k u b)` [] THEN
  have `~(poly_eval(k:K ring) u b = ring_0 k)` [not_coprime_if_shared_root] THEN
  have `ring_mul(k:K ring) (ring_mul k (poly_eval k u g) (poly_eval k u g)) (poly_eval k u b) = poly_eval k u q` [INTEGRAL_DOMAIN_MUL_RCANCEL;poly_eval_in_ring;RING_MUL] THEN
  have `ring_mul(k:K ring) (poly_eval k u G) (poly_eval k u b) = poly_eval k u q` [poly_eval_mul;RING_MUL] THEN
  have `poly_eval(k:K ring) u (ring_mul(x_ring k) G b) = poly_eval k u q` [poly_eval_mul;RING_MUL] THEN
  qed[x_derivative_bernoulli_rule]
);;

let goppa_checking_2 = prove(`
  !(k:K ring) S g G A B t a b Aprime aprime aBbA e r.
  field k ==>
  ring_char k = 2 ==>
  S SUBSET ring_carrier k ==>
  FINITE S ==>
  A = monic_vanishing_at k S ==> 
  Aprime = x_derivative k A ==>
  g IN ring_carrier(x_ring k) ==>
  twodeg k g = 2 EXP t ==>
  G = ring_mul(x_ring k) g g ==>
  ring_coprime(x_ring k) (g,A) ==>
  B IN ring_carrier(x_ring k) ==>
  a IN ring_carrier(x_ring k) ==>
  aprime = x_derivative k a ==>
  b IN ring_carrier(x_ring k) ==>
  ring_coprime(x_ring k) (a,b) ==>
  twodeg k a <= 2 EXP t ==> 
  ring_divides(x_ring k) a A ==>
  aBbA = ring_sub(x_ring k)
           (ring_mul(x_ring k) a B)
           (ring_mul(x_ring k) b A) ==>
  2 EXP (2*t) * twodeg k aBbA < twodeg k A * twodeg k a ==>
  (!s. s IN S ==>
   r s = ring_div k
           (poly_eval k s (ring_mul(x_ring k) G B))
           (poly_eval k s Aprime)) ==>
  (!s. s IN S ==> ring_pow k (r s) 2 = r s) ==>
  (!s. s IN S ==>
       e s = if poly_eval k s a = ring_0 k then ring_1 k
             else ring_0 k) ==>
  (   ring_divides(x_ring k) a
        (ring_sub(x_ring k) (ring_mul(x_ring k) G b) aprime)
   /\ 2 EXP hamming_weight k e S = twodeg k a
   /\ ring_divides(x_ring k) G (
        ring_sum(x_ring k) S
          (\s. ring_mul(x_ring k)
                 (poly_const k (ring_sub k (r s) (e s)))
                 (monic_vanishing_at_except k S s))))
`,
  REPEAT GEN_TAC THEN
  REPEAT DISCH_TAC THEN
  def `Gba:(num->num)->K` `ring_sub(x_ring(k:K ring)) (ring_mul(x_ring k) G b) aprime` THEN
  have `G IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `ring_mul(x_ring k) G b IN ring_carrier(x_ring(k:K ring))` [RING_MUL] THEN
  have `aprime IN ring_carrier(x_ring(k:K ring))` [x_derivative_in_x_ring] THEN
  have `Gba IN ring_carrier(x_ring(k:K ring))` [RING_SUB] THEN
  subgoal `!u:K. u IN S ==> poly_eval k u a = ring_0 k ==> poly_eval k u Gba = ring_0 k` THENL [
    intro THEN
    specialize[`k:K ring`;`S:K->bool`;`g:(num->num)->K`;`G:(num->num)->K`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`;`a:(num->num)->K`;`b:(num->num)->K`;`Aprime:(num->num)->K`;`aprime:(num->num)->K`;`aBbA:(num->num)->K`;`e:K->K`;`r:K->K`;`u:K`]goppa_checking_2_mainlemma THEN
    have `u IN ring_carrier(k:K ring)` [SUBSET] THEN
    have `poly_eval(k:K ring) u Gba = ring_sub k (poly_eval k u (ring_mul(x_ring k) G b)) (poly_eval k u aprime)` [poly_eval_sub;poly_eval_in_ring] THEN
    qed[RING_SUB_REFL;poly_eval_in_ring]
  ; pass
  ] THEN
  specialize[`k:K ring`;`S:K->bool`;`A:(num->num)->K`;`a:(num->num)->K`;`Gba:(num->num)->K`]divides_if_roots_and_divides_monic_vanishing_at THEN
  have `ring_divides (x_ring(k:K ring)) a (ring_sub (x_ring k) (ring_mul (x_ring k) G b) aprime)` [] THEN
  have `twodeg(k:K ring) G = twodeg k g * twodeg k g` [twodeg_mul;FIELD_IMP_INTEGRAL_DOMAIN] THEN
  have `twodeg(k:K ring) G = 2 EXP t * 2 EXP t` [] THEN
  have `twodeg(k:K ring) G = 2 EXP (2*t)` [EXP_ADD;ARITH_RULE `2*t = t+t`] THEN
  specialize[`k:K ring`;`S:K->bool`;`G:(num->num)->K`;`A:(num->num)->K`;`B:(num->num)->K`;`t:num`;`a:(num->num)->K`;`b:(num->num)->K`;`Aprime:(num->num)->K`;`aprime:(num->num)->K`;`aBbA:(num->num)->K`;`e:K->K`]goppa_checking THEN
  specialize_raw[`x_ring(k:K ring)`;`\s:K. ring_mul (x_ring(k:K ring)) (poly_const k (ring_sub k (ring_div k (poly_eval k s (ring_mul (x_ring k) G B)) (poly_eval k s Aprime)) (e s))) (monic_vanishing_at_except k S s)`;`\s:K. ring_mul (x_ring k) (poly_const k (ring_sub k (r s) (e s))) (monic_vanishing_at_except k S s)`;`S:K->bool`]RING_SUM_EQ THEN
  qed[]
);;

(* ----- summarize main theorem statements *)

let twodeg_interpolator = twodeg_interpolator;;
let eval_interpolator = eval_interpolator;;
let interpolator_unique = interpolator_unique;;
let small_approximant_exists = small_approximant_exists;;
let approximant_best = approximant_best;;
let interpolation_with_errors = interpolation_with_errors;;
let checking_interpolation_with_errors = checking_interpolation_with_errors;;
let goppa_decoding = goppa_decoding;;
let goppa_checking = goppa_checking;;
let goppa_parity = goppa_parity;;
let goppa_squaring = goppa_squaring;;
let goppa_checking_2 = goppa_checking_2;;