src/HOL/Semiring_Normalization.thy
changeset 36871 3763c349c8c1
parent 36845 d778c64fc35d
child 36872 6520ba1256a6
equal deleted inserted replaced
36870:b897bd9ca71b 36871:3763c349c8c1
    48       hence "w = x" using kp by simp }
    48       hence "w = x" using kp by simp }
    49     ultimately have "w=x" by blast }
    49     ultimately have "w=x" by blast }
    50   then show "w * y + x * z = w * z + x * y \<longleftrightarrow> w = x \<or> y = z" by auto
    50   then show "w * y + x * z = w * z + x * y \<longleftrightarrow> w = x \<or> y = z" by auto
    51 qed
    51 qed
    52 
    52 
       
    53 text {* semiring normalization proper *}
       
    54 
    53 setup Semiring_Normalizer.setup
    55 setup Semiring_Normalizer.setup
    54 
    56 
    55 lemma (in comm_semiring_1) semiring_ops:
    57 context comm_semiring_1
       
    58 begin
       
    59 
       
    60 lemma semiring_ops:
    56   shows "TERM (x + y)" and "TERM (x * y)" and "TERM (x ^ n)"
    61   shows "TERM (x + y)" and "TERM (x * y)" and "TERM (x ^ n)"
    57     and "TERM 0" and "TERM 1" .
    62     and "TERM 0" and "TERM 1" .
    58 
    63 
    59 lemma (in comm_semiring_1) semiring_rules:
    64 lemma semiring_rules:
    60   "(a * m) + (b * m) = (a + b) * m"
    65   "(a * m) + (b * m) = (a + b) * m"
    61   "(a * m) + m = (a + 1) * m"
    66   "(a * m) + m = (a + 1) * m"
    62   "m + (a * m) = (a + 1) * m"
    67   "m + (a * m) = (a + 1) * m"
    63   "m + m = (1 + 1) * m"
    68   "m + m = (1 + 1) * m"
    64   "0 + a = a"
    69   "0 + a = a"
    94   "x ^ (Suc q) = x * (x ^ q)"
    99   "x ^ (Suc q) = x * (x ^ q)"
    95   "x ^ (2*n) = (x ^ n) * (x ^ n)"
   100   "x ^ (2*n) = (x ^ n) * (x ^ n)"
    96   "x ^ (Suc (2*n)) = x * ((x ^ n) * (x ^ n))"
   101   "x ^ (Suc (2*n)) = x * ((x ^ n) * (x ^ n))"
    97   by (simp_all add: algebra_simps power_add power2_eq_square power_mult_distrib power_mult)
   102   by (simp_all add: algebra_simps power_add power2_eq_square power_mult_distrib power_mult)
    98 
   103 
    99 lemmas (in comm_semiring_1) normalizing_comm_semiring_1_axioms =
   104 lemmas normalizing_comm_semiring_1_axioms =
   100   comm_semiring_1_axioms [normalizer
   105   comm_semiring_1_axioms [normalizer
   101     semiring ops: semiring_ops
   106     semiring ops: semiring_ops
   102     semiring rules: semiring_rules]
   107     semiring rules: semiring_rules]
   103 
   108 
   104 declaration (in comm_semiring_1)
   109 declaration
   105   {* Semiring_Normalizer.semiring_funs @{thm normalizing_comm_semiring_1_axioms} *}
   110   {* Semiring_Normalizer.semiring_funs @{thm normalizing_comm_semiring_1_axioms} *}
   106 
   111 
   107 lemma (in comm_ring_1) ring_ops: shows "TERM (x- y)" and "TERM (- x)" .
   112 end
   108 
   113 
   109 lemma (in comm_ring_1) ring_rules:
   114 context comm_ring_1
       
   115 begin
       
   116 
       
   117 lemma ring_ops: shows "TERM (x- y)" and "TERM (- x)" .
       
   118 
       
   119 lemma ring_rules:
   110   "- x = (- 1) * x"
   120   "- x = (- 1) * x"
   111   "x - y = x + (- y)"
   121   "x - y = x + (- y)"
   112   by (simp_all add: diff_minus)
   122   by (simp_all add: diff_minus)
   113 
   123 
   114 lemmas (in comm_ring_1) normalizing_comm_ring_1_axioms =
   124 lemmas normalizing_comm_ring_1_axioms =
   115   comm_ring_1_axioms [normalizer
   125   comm_ring_1_axioms [normalizer
   116     semiring ops: semiring_ops
   126     semiring ops: semiring_ops
   117     semiring rules: semiring_rules
   127     semiring rules: semiring_rules
   118     ring ops: ring_ops
   128     ring ops: ring_ops
   119     ring rules: ring_rules]
   129     ring rules: ring_rules]
   120 
   130 
   121 declaration (in comm_ring_1)
   131 declaration
   122   {* Semiring_Normalizer.semiring_funs @{thm normalizing_comm_ring_1_axioms} *}
   132   {* Semiring_Normalizer.semiring_funs @{thm normalizing_comm_ring_1_axioms} *}
   123 
   133 
   124 lemma (in comm_semiring_1_cancel_norm) noteq_reduce:
   134 end
       
   135 
       
   136 context comm_semiring_1_cancel_norm
       
   137 begin
       
   138 
       
   139 lemma noteq_reduce:
   125   "a \<noteq> b \<and> c \<noteq> d \<longleftrightarrow> (a * c) + (b * d) \<noteq> (a * d) + (b * c)"
   140   "a \<noteq> b \<and> c \<noteq> d \<longleftrightarrow> (a * c) + (b * d) \<noteq> (a * d) + (b * c)"
   126 proof-
   141 proof-
   127   have "a \<noteq> b \<and> c \<noteq> d \<longleftrightarrow> \<not> (a = b \<or> c = d)" by simp
   142   have "a \<noteq> b \<and> c \<noteq> d \<longleftrightarrow> \<not> (a = b \<or> c = d)" by simp
   128   also have "\<dots> \<longleftrightarrow> (a * c) + (b * d) \<noteq> (a * d) + (b * c)"
   143   also have "\<dots> \<longleftrightarrow> (a * c) + (b * d) \<noteq> (a * d) + (b * c)"
   129     using add_mult_solve by blast
   144     using add_mult_solve by blast
   130   finally show "a \<noteq> b \<and> c \<noteq> d \<longleftrightarrow> (a * c) + (b * d) \<noteq> (a * d) + (b * c)"
   145   finally show "a \<noteq> b \<and> c \<noteq> d \<longleftrightarrow> (a * c) + (b * d) \<noteq> (a * d) + (b * c)"
   131     by simp
   146     by simp
   132 qed
   147 qed
   133 
   148 
   134 lemma (in comm_semiring_1_cancel_norm) add_scale_eq_noteq:
   149 lemma add_scale_eq_noteq:
   135   "\<lbrakk>r \<noteq> 0 ; a = b \<and> c \<noteq> d\<rbrakk> \<Longrightarrow> a + (r * c) \<noteq> b + (r * d)"
   150   "\<lbrakk>r \<noteq> 0 ; a = b \<and> c \<noteq> d\<rbrakk> \<Longrightarrow> a + (r * c) \<noteq> b + (r * d)"
   136 proof(clarify)
   151 proof(clarify)
   137   assume nz: "r\<noteq> 0" and cnd: "c\<noteq>d"
   152   assume nz: "r\<noteq> 0" and cnd: "c\<noteq>d"
   138     and eq: "b + (r * c) = b + (r * d)"
   153     and eq: "b + (r * c) = b + (r * d)"
   139   have "(0 * d) + (r * c) = (0 * c) + (r * d)"
   154   have "(0 * d) + (r * c) = (0 * c) + (r * d)"
   140     using add_imp_eq eq mult_zero_left by simp
   155     using add_imp_eq eq mult_zero_left by simp
   141   thus "False" using add_mult_solve[of 0 d] nz cnd by simp
   156   thus "False" using add_mult_solve[of 0 d] nz cnd by simp
   142 qed
   157 qed
   143 
   158 
   144 lemma (in comm_semiring_1_cancel_norm) add_0_iff:
   159 lemma add_0_iff:
   145   "x = x + a \<longleftrightarrow> a = 0"
   160   "x = x + a \<longleftrightarrow> a = 0"
   146 proof-
   161 proof-
   147   have "a = 0 \<longleftrightarrow> x + a = x + 0" using add_imp_eq[of x a 0] by auto
   162   have "a = 0 \<longleftrightarrow> x + a = x + 0" using add_imp_eq[of x a 0] by auto
   148   thus "x = x + a \<longleftrightarrow> a = 0" by (auto simp add: add_commute)
   163   thus "x = x + a \<longleftrightarrow> a = 0" by (auto simp add: add_commute)
   149 qed
   164 qed
   150 
   165 
   151 declare (in comm_semiring_1_cancel_norm)
   166 declare
   152   normalizing_comm_semiring_1_axioms [normalizer del]
   167   normalizing_comm_semiring_1_axioms [normalizer del]
   153 
   168 
   154 lemmas (in comm_semiring_1_cancel_norm)
   169 lemmas
   155   normalizing_comm_semiring_1_cancel_norm_axioms =
   170   normalizing_comm_semiring_1_cancel_norm_axioms =
   156   comm_semiring_1_cancel_norm_axioms [normalizer
   171   comm_semiring_1_cancel_norm_axioms [normalizer
   157     semiring ops: semiring_ops
   172     semiring ops: semiring_ops
   158     semiring rules: semiring_rules
   173     semiring rules: semiring_rules
   159     idom rules: noteq_reduce add_scale_eq_noteq]
   174     idom rules: noteq_reduce add_scale_eq_noteq]
   160 
   175 
   161 declaration (in comm_semiring_1_cancel_norm)
   176 declaration
   162   {* Semiring_Normalizer.semiring_funs @{thm normalizing_comm_semiring_1_cancel_norm_axioms} *}
   177   {* Semiring_Normalizer.semiring_funs @{thm normalizing_comm_semiring_1_cancel_norm_axioms} *}
   163 
   178 
   164 declare (in idom) normalizing_comm_ring_1_axioms [normalizer del]
   179 end
   165 
   180 
   166 lemmas (in idom) normalizing_idom_axioms = idom_axioms [normalizer
   181 context idom
       
   182 begin
       
   183 
       
   184 declare normalizing_comm_ring_1_axioms [normalizer del]
       
   185 
       
   186 lemmas normalizing_idom_axioms = idom_axioms [normalizer
   167   semiring ops: semiring_ops
   187   semiring ops: semiring_ops
   168   semiring rules: semiring_rules
   188   semiring rules: semiring_rules
   169   ring ops: ring_ops
   189   ring ops: ring_ops
   170   ring rules: ring_rules
   190   ring rules: ring_rules
   171   idom rules: noteq_reduce add_scale_eq_noteq
   191   idom rules: noteq_reduce add_scale_eq_noteq
   172   ideal rules: right_minus_eq add_0_iff]
   192   ideal rules: right_minus_eq add_0_iff]
   173 
   193 
   174 declaration (in idom)
   194 declaration
   175   {* Semiring_Normalizer.semiring_funs @{thm normalizing_idom_axioms} *}
   195   {* Semiring_Normalizer.semiring_funs @{thm normalizing_idom_axioms} *}
   176 
   196 
   177 lemma (in field) field_ops:
   197 end
       
   198 
       
   199 context field
       
   200 begin
       
   201 
       
   202 lemma field_ops:
   178   shows "TERM (x / y)" and "TERM (inverse x)" .
   203   shows "TERM (x / y)" and "TERM (inverse x)" .
   179 
   204 
   180 lemmas (in field) field_rules = divide_inverse inverse_eq_divide
   205 lemmas field_rules = divide_inverse inverse_eq_divide
   181 
   206 
   182 lemmas (in field) normalizing_field_axioms =
   207 lemmas normalizing_field_axioms =
   183   field_axioms [normalizer
   208   field_axioms [normalizer
   184     semiring ops: semiring_ops
   209     semiring ops: semiring_ops
   185     semiring rules: semiring_rules
   210     semiring rules: semiring_rules
   186     ring ops: ring_ops
   211     ring ops: ring_ops
   187     ring rules: ring_rules
   212     ring rules: ring_rules
   188     field ops: field_ops
   213     field ops: field_ops
   189     field rules: field_rules
   214     field rules: field_rules
   190     idom rules: noteq_reduce add_scale_eq_noteq
   215     idom rules: noteq_reduce add_scale_eq_noteq
   191     ideal rules: right_minus_eq add_0_iff]
   216     ideal rules: right_minus_eq add_0_iff]
   192 
   217 
   193 declaration (in field)
   218 declaration
   194   {* Semiring_Normalizer.field_funs @{thm normalizing_field_axioms} *}
   219   {* Semiring_Normalizer.field_funs @{thm normalizing_field_axioms} *}
       
   220 
       
   221 end
   195 
   222 
   196 hide_fact (open) normalizing_comm_semiring_1_axioms
   223 hide_fact (open) normalizing_comm_semiring_1_axioms
   197   normalizing_comm_semiring_1_cancel_norm_axioms semiring_ops semiring_rules
   224   normalizing_comm_semiring_1_cancel_norm_axioms semiring_ops semiring_rules
   198 
   225 
   199 hide_fact (open) normalizing_comm_ring_1_axioms
   226 hide_fact (open) normalizing_comm_ring_1_axioms
   200   normalizing_idom_axioms ring_ops ring_rules
   227   normalizing_idom_axioms ring_ops ring_rules
   201 
   228 
   202 hide_fact (open)  normalizing_field_axioms field_ops field_rules
   229 hide_fact (open) normalizing_field_axioms field_ops field_rules
   203 
   230 
   204 hide_fact (open) add_scale_eq_noteq noteq_reduce
   231 hide_fact (open) add_scale_eq_noteq noteq_reduce
   205 
   232 
   206 end
   233 end