author | paulson <lp15@cam.ac.uk> |
Thu, 22 Aug 2024 22:26:28 +0100 | |
changeset 80736 | c8bcb14fcfa8 |
parent 67613 | ce654b0e6d69 |
child 80756 | 4d592706086e |
permissions | -rw-r--r-- |
47455 | 1 |
(* Title: HOL/Matrix_LP/SparseMatrix.thy |
16487 | 2 |
Author: Steven Obua |
3 |
*) |
|
4 |
||
27484 | 5 |
theory SparseMatrix |
80736 | 6 |
imports Matrix |
27484 | 7 |
begin |
15009 | 8 |
|
42463 | 9 |
type_synonym 'a spvec = "(nat * 'a) list" |
10 |
type_synonym 'a spmat = "'a spvec spvec" |
|
15009 | 11 |
|
38273 | 12 |
definition sparse_row_vector :: "('a::ab_group_add) spvec \<Rightarrow> 'a matrix" |
13 |
where "sparse_row_vector arr = foldl (% m x. m + (singleton_matrix 0 (fst x) (snd x))) 0 arr" |
|
15009 | 14 |
|
38273 | 15 |
definition sparse_row_matrix :: "('a::ab_group_add) spmat \<Rightarrow> 'a matrix" |
16 |
where "sparse_row_matrix arr = foldl (% m r. m + (move_matrix (sparse_row_vector (snd r)) (int (fst r)) 0)) 0 arr" |
|
15009 | 17 |
|
27484 | 18 |
code_datatype sparse_row_vector sparse_row_matrix |
19 |
||
20 |
lemma sparse_row_vector_empty [simp]: "sparse_row_vector [] = 0" |
|
15009 | 21 |
by (simp add: sparse_row_vector_def) |
22 |
||
27484 | 23 |
lemma sparse_row_matrix_empty [simp]: "sparse_row_matrix [] = 0" |
15009 | 24 |
by (simp add: sparse_row_matrix_def) |
25 |
||
28562 | 26 |
lemmas [code] = sparse_row_vector_empty [symmetric] |
27484 | 27 |
|
67613 | 28 |
lemma foldl_distrstart: "\<forall>a x y. (f (g x y) a = g x (f y a)) \<Longrightarrow> (foldl f (g x y) l = g x (foldl f y l))" |
31817 | 29 |
by (induct l arbitrary: x y, auto) |
15009 | 30 |
|
27653 | 31 |
lemma sparse_row_vector_cons[simp]: |
32 |
"sparse_row_vector (a # arr) = (singleton_matrix 0 (fst a) (snd a)) + (sparse_row_vector arr)" |
|
80736 | 33 |
by (induct arr) (auto simp: foldl_distrstart sparse_row_vector_def) |
15009 | 34 |
|
27653 | 35 |
lemma sparse_row_vector_append[simp]: |
36 |
"sparse_row_vector (a @ b) = (sparse_row_vector a) + (sparse_row_vector b)" |
|
37 |
by (induct a) auto |
|
15009 | 38 |
|
80736 | 39 |
lemma nrows_spvec[simp]: "nrows (sparse_row_vector x) \<le> (Suc 0)" |
40 |
by (induct x) (auto simp: add_nrows) |
|
15009 | 41 |
|
42 |
lemma sparse_row_matrix_cons: "sparse_row_matrix (a#arr) = ((move_matrix (sparse_row_vector (snd a)) (int (fst a)) 0)) + sparse_row_matrix arr" |
|
80736 | 43 |
by (induct arr) (auto simp: foldl_distrstart sparse_row_matrix_def) |
15009 | 44 |
|
45 |
lemma sparse_row_matrix_append: "sparse_row_matrix (arr@brr) = (sparse_row_matrix arr) + (sparse_row_matrix brr)" |
|
80736 | 46 |
by (induct arr) (auto simp: sparse_row_matrix_cons) |
15009 | 47 |
|
80736 | 48 |
fun sorted_spvec :: "'a spvec \<Rightarrow> bool" |
38273 | 49 |
where |
27653 | 50 |
"sorted_spvec [] = True" |
80736 | 51 |
| sorted_spvec_step1: "sorted_spvec [a] = True" |
52 |
| sorted_spvec_step: "sorted_spvec ((m,x)#(n,y)#bs) = ((m < n) \<and> (sorted_spvec ((n,y)#bs)))" |
|
15009 | 53 |
|
38273 | 54 |
primrec sorted_spmat :: "'a spmat \<Rightarrow> bool" |
55 |
where |
|
15009 | 56 |
"sorted_spmat [] = True" |
80736 | 57 |
| "sorted_spmat (a#as) = ((sorted_spvec (snd a)) \<and> (sorted_spmat as))" |
15009 | 58 |
|
59 |
declare sorted_spvec.simps [simp del] |
|
60 |
||
61 |
lemma sorted_spvec_empty[simp]: "sorted_spvec [] = True" |
|
80736 | 62 |
by (simp add: sorted_spvec.simps) |
15009 | 63 |
|
64 |
lemma sorted_spvec_cons1: "sorted_spvec (a#as) \<Longrightarrow> sorted_spvec as" |
|
80736 | 65 |
using sorted_spvec.elims(2) sorted_spvec_empty by blast |
15009 | 66 |
|
67 |
lemma sorted_spvec_cons2: "sorted_spvec (a#b#t) \<Longrightarrow> sorted_spvec (a#t)" |
|
80736 | 68 |
by (smt (verit, del_insts) sorted_spvec_step order.strict_trans list.inject sorted_spvec.elims(3) surj_pair) |
15009 | 69 |
|
70 |
lemma sorted_spvec_cons3: "sorted_spvec(a#b#t) \<Longrightarrow> fst a < fst b" |
|
80736 | 71 |
by (metis sorted_spvec_step prod.collapse) |
15009 | 72 |
|
80736 | 73 |
lemma sorted_sparse_row_vector_zero: |
74 |
assumes "m \<le> n" |
|
75 |
shows "sorted_spvec ((n,a)#arr) \<Longrightarrow> Rep_matrix (sparse_row_vector arr) j m = 0" |
|
76 |
proof (induct arr) |
|
77 |
case Nil |
|
78 |
then show ?case by auto |
|
79 |
next |
|
80 |
case (Cons a arr) |
|
81 |
with assms show ?case |
|
82 |
by (auto dest: sorted_spvec_cons2 sorted_spvec_cons3) |
|
83 |
qed |
|
15009 | 84 |
|
80736 | 85 |
lemma sorted_sparse_row_matrix_zero[rule_format]: |
86 |
assumes "m \<le> n" |
|
87 |
shows "sorted_spvec ((n,a)#arr) \<Longrightarrow> Rep_matrix (sparse_row_matrix arr) m j = 0" |
|
88 |
proof (induct arr) |
|
89 |
case Nil |
|
90 |
then show ?case by auto |
|
91 |
next |
|
92 |
case (Cons a arr) |
|
93 |
with assms show ?case |
|
94 |
unfolding sparse_row_matrix_cons |
|
95 |
by (auto dest: sorted_spvec_cons2 sorted_spvec_cons3) |
|
96 |
qed |
|
15009 | 97 |
|
38273 | 98 |
primrec minus_spvec :: "('a::ab_group_add) spvec \<Rightarrow> 'a spvec" |
99 |
where |
|
15178 | 100 |
"minus_spvec [] = []" |
38273 | 101 |
| "minus_spvec (a#as) = (fst a, -(snd a))#(minus_spvec as)" |
15178 | 102 |
|
38273 | 103 |
primrec abs_spvec :: "('a::lattice_ab_group_add_abs) spvec \<Rightarrow> 'a spvec" |
104 |
where |
|
15178 | 105 |
"abs_spvec [] = []" |
61945 | 106 |
| "abs_spvec (a#as) = (fst a, \<bar>snd a\<bar>)#(abs_spvec as)" |
15178 | 107 |
|
108 |
lemma sparse_row_vector_minus: |
|
109 |
"sparse_row_vector (minus_spvec v) = - (sparse_row_vector v)" |
|
80736 | 110 |
proof (induct v) |
111 |
case Nil |
|
112 |
then show ?case |
|
113 |
by auto |
|
114 |
next |
|
115 |
case (Cons a v) |
|
116 |
then have "singleton_matrix 0 (fst a) (- snd a) = - singleton_matrix 0 (fst a) (snd a)" |
|
117 |
by (simp add: Rep_matrix_inject minus_matrix_def) |
|
118 |
then show ?case |
|
119 |
by (simp add: local.Cons) |
|
120 |
qed |
|
27653 | 121 |
|
15178 | 122 |
lemma sparse_row_vector_abs: |
61945 | 123 |
"sorted_spvec (v :: 'a::lattice_ring spvec) \<Longrightarrow> sparse_row_vector (abs_spvec v) = \<bar>sparse_row_vector v\<bar>" |
80736 | 124 |
proof (induct v) |
125 |
case Nil |
|
126 |
then show ?case |
|
127 |
by simp |
|
128 |
next |
|
129 |
case (Cons ab v) |
|
130 |
then have v: "sorted_spvec v" |
|
131 |
using sorted_spvec_cons1 by blast |
|
132 |
show ?case |
|
133 |
proof (cases ab) |
|
134 |
case (Pair a b) |
|
135 |
then have 0: "Rep_matrix (sparse_row_vector v) 0 a = 0" |
|
136 |
using Cons.prems sorted_sparse_row_vector_zero by blast |
|
137 |
with v Cons show ?thesis |
|
138 |
by (fastforce simp: Pair simp flip: Rep_matrix_inject) |
|
139 |
qed |
|
140 |
qed |
|
15178 | 141 |
|
142 |
lemma sorted_spvec_minus_spvec: |
|
143 |
"sorted_spvec v \<Longrightarrow> sorted_spvec (minus_spvec v)" |
|
80736 | 144 |
by (induct v rule: sorted_spvec.induct) (auto simp: sorted_spvec_step1 sorted_spvec_step) |
15178 | 145 |
|
146 |
lemma sorted_spvec_abs_spvec: |
|
147 |
"sorted_spvec v \<Longrightarrow> sorted_spvec (abs_spvec v)" |
|
80736 | 148 |
by (induct v rule: sorted_spvec.induct) (auto simp: sorted_spvec_step1 sorted_spvec_step) |
15178 | 149 |
|
38273 | 150 |
definition "smult_spvec y = map (% a. (fst a, y * snd a))" |
15009 | 151 |
|
152 |
lemma smult_spvec_empty[simp]: "smult_spvec y [] = []" |
|
153 |
by (simp add: smult_spvec_def) |
|
154 |
||
155 |
lemma smult_spvec_cons: "smult_spvec y (a#arr) = (fst a, y * (snd a)) # (smult_spvec y arr)" |
|
156 |
by (simp add: smult_spvec_def) |
|
157 |
||
38273 | 158 |
fun addmult_spvec :: "('a::ring) \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec" |
159 |
where |
|
160 |
"addmult_spvec y arr [] = arr" |
|
161 |
| "addmult_spvec y [] brr = smult_spvec y brr" |
|
162 |
| "addmult_spvec y ((i,a)#arr) ((j,b)#brr) = ( |
|
31816 | 163 |
if i < j then ((i,a)#(addmult_spvec y arr ((j,b)#brr))) |
164 |
else (if (j < i) then ((j, y * b)#(addmult_spvec y ((i,a)#arr) brr)) |
|
165 |
else ((i, a + y*b)#(addmult_spvec y arr brr))))" |
|
166 |
(* Steven used termination "measure (% (y, a, b). length a + (length b))" *) |
|
15009 | 167 |
|
31816 | 168 |
lemma addmult_spvec_empty1[simp]: "addmult_spvec y [] a = smult_spvec y a" |
27484 | 169 |
by (induct a) auto |
15009 | 170 |
|
31816 | 171 |
lemma addmult_spvec_empty2[simp]: "addmult_spvec y a [] = a" |
80736 | 172 |
by simp |
15009 | 173 |
|
67613 | 174 |
lemma sparse_row_vector_map: "(\<forall>x y. f (x+y) = (f x) + (f y)) \<Longrightarrow> (f::'a\<Rightarrow>('a::lattice_ring)) 0 = 0 \<Longrightarrow> |
15009 | 175 |
sparse_row_vector (map (% x. (fst x, f (snd x))) a) = apply_matrix f (sparse_row_vector a)" |
80736 | 176 |
by (induct a) (simp_all add: apply_matrix_add) |
15009 | 177 |
|
178 |
lemma sparse_row_vector_smult: "sparse_row_vector (smult_spvec y a) = scalar_mult y (sparse_row_vector a)" |
|
80736 | 179 |
by (induct a) (simp_all add: smult_spvec_cons scalar_mult_add) |
15009 | 180 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
181 |
lemma sparse_row_vector_addmult_spvec: "sparse_row_vector (addmult_spvec (y::'a::lattice_ring) a b) = |
15009 | 182 |
(sparse_row_vector a) + (scalar_mult y (sparse_row_vector b))" |
80736 | 183 |
by (induct y a b rule: addmult_spvec.induct) |
184 |
(simp_all add: scalar_mult_add smult_spvec_cons sparse_row_vector_smult singleton_matrix_add) |
|
15009 | 185 |
|
31817 | 186 |
lemma sorted_smult_spvec: "sorted_spvec a \<Longrightarrow> sorted_spvec (smult_spvec y a)" |
80736 | 187 |
by (induct a rule: sorted_spvec.induct) (auto simp: smult_spvec_def sorted_spvec_step1 sorted_spvec_step) |
15009 | 188 |
|
31816 | 189 |
lemma sorted_spvec_addmult_spvec_helper: "\<lbrakk>sorted_spvec (addmult_spvec y ((a, b) # arr) brr); aa < a; sorted_spvec ((a, b) # arr); |
190 |
sorted_spvec ((aa, ba) # brr)\<rbrakk> \<Longrightarrow> sorted_spvec ((aa, y * ba) # addmult_spvec y ((a, b) # arr) brr)" |
|
80736 | 191 |
by (induct brr) (auto simp: sorted_spvec.simps) |
15009 | 192 |
|
193 |
lemma sorted_spvec_addmult_spvec_helper2: |
|
31816 | 194 |
"\<lbrakk>sorted_spvec (addmult_spvec y arr ((aa, ba) # brr)); a < aa; sorted_spvec ((a, b) # arr); sorted_spvec ((aa, ba) # brr)\<rbrakk> |
195 |
\<Longrightarrow> sorted_spvec ((a, b) # addmult_spvec y arr ((aa, ba) # brr))" |
|
80736 | 196 |
by (induct arr) (auto simp: smult_spvec_def sorted_spvec.simps) |
15009 | 197 |
|
198 |
lemma sorted_spvec_addmult_spvec_helper3[rule_format]: |
|
80736 | 199 |
"sorted_spvec (addmult_spvec y arr brr) \<Longrightarrow> |
200 |
sorted_spvec ((aa, b) # arr) \<Longrightarrow> |
|
201 |
sorted_spvec ((aa, ba) # brr) \<Longrightarrow> |
|
202 |
sorted_spvec ((aa, b + y * ba) # (addmult_spvec y arr brr))" |
|
203 |
by (smt (verit, ccfv_threshold) sorted_spvec_step addmult_spvec.simps(1) list.distinct(1) list.sel(3) sorted_spvec.elims(1) sorted_spvec_addmult_spvec_helper2) |
|
15009 | 204 |
|
31817 | 205 |
lemma sorted_addmult_spvec: "sorted_spvec a \<Longrightarrow> sorted_spvec b \<Longrightarrow> sorted_spvec (addmult_spvec y a b)" |
80736 | 206 |
proof (induct y a b rule: addmult_spvec.induct) |
207 |
case (1 y arr) |
|
208 |
then show ?case |
|
209 |
by simp |
|
210 |
next |
|
211 |
case (2 y v va) |
|
212 |
then show ?case |
|
213 |
by (simp add: sorted_smult_spvec) |
|
214 |
next |
|
215 |
case (3 y i a arr j b brr) |
|
216 |
show ?case |
|
217 |
proof (cases i j rule: linorder_cases) |
|
218 |
case less |
|
219 |
with 3 show ?thesis |
|
220 |
by (simp add: sorted_spvec_addmult_spvec_helper2 sorted_spvec_cons1) |
|
221 |
next |
|
222 |
case equal |
|
223 |
with 3 show ?thesis |
|
224 |
by (simp add: sorted_spvec_addmult_spvec_helper3 sorted_spvec_cons1) |
|
225 |
next |
|
226 |
case greater |
|
227 |
with 3 show ?thesis |
|
228 |
by (simp add: sorted_spvec_addmult_spvec_helper sorted_spvec_cons1) |
|
229 |
qed |
|
230 |
qed |
|
15009 | 231 |
|
38273 | 232 |
fun mult_spvec_spmat :: "('a::lattice_ring) spvec \<Rightarrow> 'a spvec \<Rightarrow> 'a spmat \<Rightarrow> 'a spvec" |
233 |
where |
|
234 |
"mult_spvec_spmat c [] brr = c" |
|
235 |
| "mult_spvec_spmat c arr [] = c" |
|
236 |
| "mult_spvec_spmat c ((i,a)#arr) ((j,b)#brr) = ( |
|
31816 | 237 |
if (i < j) then mult_spvec_spmat c arr ((j,b)#brr) |
238 |
else if (j < i) then mult_spvec_spmat c ((i,a)#arr) brr |
|
239 |
else mult_spvec_spmat (addmult_spvec a c b) arr brr)" |
|
15009 | 240 |
|
80736 | 241 |
lemma sparse_row_mult_spvec_spmat: |
242 |
assumes "sorted_spvec (a::('a::lattice_ring) spvec)" "sorted_spvec B" |
|
243 |
shows "sparse_row_vector (mult_spvec_spmat c a B) = (sparse_row_vector c) + (sparse_row_vector a) * (sparse_row_matrix B)" |
|
15009 | 244 |
proof - |
80736 | 245 |
have comp_1: "!! a b. a < b \<Longrightarrow> Suc 0 \<le> nat ((int b)-(int a))" by arith |
15009 | 246 |
have not_iff: "!! a b. a = b \<Longrightarrow> (~ a) = (~ b)" by simp |
247 |
{ |
|
248 |
fix a |
|
80736 | 249 |
fix v :: "(nat \<times> 'a) list" |
250 |
assume a: "a < nrows(sparse_row_vector v)" |
|
251 |
have "nrows(sparse_row_vector v) \<le> 1" by simp |
|
252 |
then have "a = 0" |
|
253 |
using a dual_order.strict_trans1 by blast |
|
15009 | 254 |
} |
255 |
note nrows_helper = this |
|
256 |
show ?thesis |
|
80736 | 257 |
using assms |
258 |
proof (induct c a B rule: mult_spvec_spmat.induct) |
|
259 |
case (1 c brr) |
|
260 |
then show ?case |
|
261 |
by simp |
|
262 |
next |
|
263 |
case (2 c v va) |
|
264 |
then show ?case |
|
265 |
by simp |
|
266 |
next |
|
267 |
case (3 c i a arr j b brr) |
|
268 |
then have abrr: "sorted_spvec arr" "sorted_spvec brr" |
|
269 |
using sorted_spvec_cons1 by blast+ |
|
270 |
have "\<And>m n. \<lbrakk>a \<noteq> 0; 0 < m\<rbrakk> |
|
271 |
\<Longrightarrow> a * Rep_matrix (sparse_row_vector b) m n = 0" |
|
272 |
by (metis mult_zero_right neq0_conv nrows_helper nrows_notzero) |
|
273 |
then have \<dagger>: "scalar_mult a (sparse_row_vector b) = |
|
274 |
singleton_matrix 0 j a * move_matrix (sparse_row_vector b) (int j) 0" |
|
275 |
apply (intro matrix_eqI) |
|
276 |
apply (simp) |
|
277 |
apply (subst Rep_matrix_mult) |
|
278 |
apply (subst foldseq_almostzero, auto) |
|
279 |
done |
|
280 |
show ?case |
|
281 |
proof (cases i j rule: linorder_cases) |
|
282 |
case less |
|
283 |
with 3 abrr \<dagger> show ?thesis |
|
284 |
apply (simp add: algebra_simps sparse_row_matrix_cons Rep_matrix_zero_imp_mult_zero) |
|
285 |
by (metis Rep_matrix_zero_imp_mult_zero Rep_singleton_matrix less_imp_le_nat sorted_sparse_row_matrix_zero) |
|
286 |
next |
|
287 |
case equal |
|
288 |
with 3 abrr \<dagger> show ?thesis |
|
289 |
apply (simp add: sparse_row_matrix_cons algebra_simps sparse_row_vector_addmult_spvec) |
|
290 |
apply (subst Rep_matrix_zero_imp_mult_zero) |
|
291 |
using sorted_sparse_row_matrix_zero apply fastforce |
|
292 |
apply (subst Rep_matrix_zero_imp_mult_zero) |
|
293 |
apply (metis Rep_move_matrix comp_1 nrows_le nrows_spvec sorted_sparse_row_vector_zero verit_comp_simplify1(3)) |
|
294 |
apply (simp add: ) |
|
295 |
done |
|
296 |
next |
|
297 |
case greater |
|
298 |
have "Rep_matrix (sparse_row_vector arr) j' k = 0 \<or> |
|
299 |
Rep_matrix (move_matrix (sparse_row_vector b) (int j) 0) k |
|
300 |
i' = 0" |
|
301 |
if "sorted_spvec ((i, a) # arr)" for j' i' k |
|
302 |
proof (cases "k \<le> j") |
|
303 |
case True |
|
304 |
with greater that show ?thesis |
|
305 |
by (meson order.trans nat_less_le sorted_sparse_row_vector_zero) |
|
306 |
qed (use nrows_helper nrows_notzero in force) |
|
307 |
then have "sparse_row_vector arr * move_matrix (sparse_row_vector b) (int j) 0 = 0" |
|
308 |
using greater 3 |
|
309 |
by (simp add: Rep_matrix_zero_imp_mult_zero) |
|
310 |
with greater 3 abrr show ?thesis |
|
311 |
apply (simp add: algebra_simps sparse_row_matrix_cons) |
|
312 |
by (metis Rep_matrix_zero_imp_mult_zero Rep_move_matrix Rep_singleton_matrix comp_1 nrows_le nrows_spvec) |
|
313 |
qed |
|
314 |
qed |
|
15009 | 315 |
qed |
316 |
||
80736 | 317 |
lemma sorted_mult_spvec_spmat: |
318 |
"sorted_spvec (c::('a::lattice_ring) spvec) \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spvec (mult_spvec_spmat c a B)" |
|
319 |
by (induct c a B rule: mult_spvec_spmat.induct) (simp_all add: sorted_addmult_spvec) |
|
15009 | 320 |
|
38273 | 321 |
primrec mult_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" |
322 |
where |
|
15009 | 323 |
"mult_spmat [] A = []" |
38273 | 324 |
| "mult_spmat (a#as) A = (fst a, mult_spvec_spmat [] (snd a) A)#(mult_spmat as A)" |
15009 | 325 |
|
31817 | 326 |
lemma sparse_row_mult_spmat: |
327 |
"sorted_spmat A \<Longrightarrow> sorted_spvec B \<Longrightarrow> |
|
328 |
sparse_row_matrix (mult_spmat A B) = (sparse_row_matrix A) * (sparse_row_matrix B)" |
|
80736 | 329 |
by (induct A) (auto simp: sparse_row_matrix_cons sparse_row_mult_spvec_spmat algebra_simps move_matrix_mult) |
15009 | 330 |
|
80736 | 331 |
lemma sorted_spvec_mult_spmat: |
332 |
fixes A :: "('a::lattice_ring) spmat" |
|
333 |
shows "sorted_spvec A \<Longrightarrow> sorted_spvec (mult_spmat A B)" |
|
334 |
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps) |
|
15009 | 335 |
|
31817 | 336 |
lemma sorted_spmat_mult_spmat: |
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
337 |
"sorted_spmat (B::('a::lattice_ring) spmat) \<Longrightarrow> sorted_spmat (mult_spmat A B)" |
80736 | 338 |
by (induct A) (auto simp: sorted_mult_spvec_spmat) |
15009 | 339 |
|
340 |
||
38273 | 341 |
fun add_spvec :: "('a::lattice_ab_group_add) spvec \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec" |
342 |
where |
|
31816 | 343 |
(* "measure (% (a, b). length a + (length b))" *) |
38273 | 344 |
"add_spvec arr [] = arr" |
345 |
| "add_spvec [] brr = brr" |
|
346 |
| "add_spvec ((i,a)#arr) ((j,b)#brr) = ( |
|
347 |
if i < j then (i,a)#(add_spvec arr ((j,b)#brr)) |
|
31816 | 348 |
else if (j < i) then (j,b) # add_spvec ((i,a)#arr) brr |
349 |
else (i, a+b) # add_spvec arr brr)" |
|
15009 | 350 |
|
31816 | 351 |
lemma add_spvec_empty1[simp]: "add_spvec [] a = a" |
80736 | 352 |
by (cases a, auto) |
15009 | 353 |
|
31816 | 354 |
lemma sparse_row_vector_add: "sparse_row_vector (add_spvec a b) = (sparse_row_vector a) + (sparse_row_vector b)" |
80736 | 355 |
by (induct a b rule: add_spvec.induct) (simp_all add: singleton_matrix_add) |
15009 | 356 |
|
38273 | 357 |
fun add_spmat :: "('a::lattice_ab_group_add) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" |
358 |
where |
|
31816 | 359 |
(* "measure (% (A,B). (length A)+(length B))" *) |
38273 | 360 |
"add_spmat [] bs = bs" |
361 |
| "add_spmat as [] = as" |
|
362 |
| "add_spmat ((i,a)#as) ((j,b)#bs) = ( |
|
363 |
if i < j then |
|
364 |
(i,a) # add_spmat as ((j,b)#bs) |
|
365 |
else if j < i then |
|
366 |
(j,b) # add_spmat ((i,a)#as) bs |
|
367 |
else |
|
368 |
(i, add_spvec a b) # add_spmat as bs)" |
|
15009 | 369 |
|
31816 | 370 |
lemma add_spmat_Nil2[simp]: "add_spmat as [] = as" |
371 |
by(cases as) auto |
|
372 |
||
373 |
lemma sparse_row_add_spmat: "sparse_row_matrix (add_spmat A B) = (sparse_row_matrix A) + (sparse_row_matrix B)" |
|
80736 | 374 |
by (induct A B rule: add_spmat.induct) (auto simp: sparse_row_matrix_cons sparse_row_vector_add move_matrix_add) |
15009 | 375 |
|
28562 | 376 |
lemmas [code] = sparse_row_add_spmat [symmetric] |
377 |
lemmas [code] = sparse_row_vector_add [symmetric] |
|
27484 | 378 |
|
31816 | 379 |
lemma sorted_add_spvec_helper1[rule_format]: "add_spvec ((a,b)#arr) brr = (ab, bb) # list \<longrightarrow> (ab = a | (brr \<noteq> [] & ab = fst (hd brr)))" |
80736 | 380 |
proof - |
381 |
have "(\<forall>x ab a. x = (a,b)#arr \<longrightarrow> add_spvec x brr = (ab, bb) # list \<longrightarrow> (ab = a | (ab = fst (hd brr))))" |
|
382 |
by (induct brr rule: add_spvec.induct) (auto split:if_splits) |
|
383 |
then show ?thesis |
|
384 |
by (case_tac brr, auto) |
|
385 |
qed |
|
15009 | 386 |
|
80736 | 387 |
lemma sorted_add_spmat_helper1[rule_format]: |
388 |
"add_spmat ((a,b)#arr) brr = (ab, bb) # list \<Longrightarrow> (ab = a | (brr \<noteq> [] & ab = fst (hd brr)))" |
|
389 |
by (smt (verit) add_spmat.elims fst_conv list.distinct(1) list.sel(1)) |
|
15009 | 390 |
|
31817 | 391 |
lemma sorted_add_spvec_helper: "add_spvec arr brr = (ab, bb) # list \<Longrightarrow> ((arr \<noteq> [] & ab = fst (hd arr)) | (brr \<noteq> [] & ab = fst (hd brr)))" |
80736 | 392 |
by (induct arr brr rule: add_spvec.induct) (auto split:if_splits) |
15009 | 393 |
|
31817 | 394 |
lemma sorted_add_spmat_helper: "add_spmat arr brr = (ab, bb) # list \<Longrightarrow> ((arr \<noteq> [] & ab = fst (hd arr)) | (brr \<noteq> [] & ab = fst (hd brr)))" |
80736 | 395 |
by (induct arr brr rule: add_spmat.induct) (auto split:if_splits) |
15009 | 396 |
|
31816 | 397 |
lemma add_spvec_commute: "add_spvec a b = add_spvec b a" |
31817 | 398 |
by (induct a b rule: add_spvec.induct) auto |
15009 | 399 |
|
31816 | 400 |
lemma add_spmat_commute: "add_spmat a b = add_spmat b a" |
80736 | 401 |
by (induct a b rule: add_spmat.induct) (simp_all add: add_spvec_commute) |
15009 | 402 |
|
31816 | 403 |
lemma sorted_add_spvec_helper2: "add_spvec ((a,b)#arr) brr = (ab, bb) # list \<Longrightarrow> aa < a \<Longrightarrow> sorted_spvec ((aa, ba) # brr) \<Longrightarrow> aa < ab" |
80736 | 404 |
by (smt (verit, best) add_spvec.elims fst_conv list.sel(1) sorted_spvec_cons3) |
15009 | 405 |
|
31816 | 406 |
lemma sorted_add_spmat_helper2: "add_spmat ((a,b)#arr) brr = (ab, bb) # list \<Longrightarrow> aa < a \<Longrightarrow> sorted_spvec ((aa, ba) # brr) \<Longrightarrow> aa < ab" |
80736 | 407 |
by (metis (no_types, opaque_lifting) add_spmat.simps(1) list.sel(1) neq_Nil_conv sorted_add_spmat_helper sorted_spvec_cons3) |
408 |
||
409 |
lemma sorted_spvec_add_spvec: "sorted_spvec a \<Longrightarrow> sorted_spvec b \<Longrightarrow> sorted_spvec (add_spvec a b)" |
|
410 |
proof (induct a b rule: add_spvec.induct) |
|
411 |
case (3 i a arr j b brr) |
|
412 |
then have "sorted_spvec arr" "sorted_spvec brr" |
|
413 |
using sorted_spvec_cons1 by blast+ |
|
414 |
with 3 show ?case |
|
415 |
apply simp |
|
416 |
by (smt (verit, ccfv_SIG) add_spvec.simps(2) list.sel(3) sorted_add_spvec_helper sorted_spvec.elims(1)) |
|
417 |
qed auto |
|
15009 | 418 |
|
80736 | 419 |
lemma sorted_spvec_add_spmat: |
420 |
"sorted_spvec A \<Longrightarrow> sorted_spvec B \<Longrightarrow> sorted_spvec (add_spmat A B)" |
|
421 |
proof (induct A B rule: add_spmat.induct) |
|
422 |
case (1 bs) |
|
423 |
then show ?case by auto |
|
424 |
next |
|
425 |
case (2 v va) |
|
426 |
then show ?case by auto |
|
427 |
next |
|
428 |
case (3 i a as j b bs) |
|
429 |
then have "sorted_spvec as" "sorted_spvec bs" |
|
430 |
using sorted_spvec_cons1 by blast+ |
|
431 |
with 3 show ?case |
|
432 |
apply simp |
|
433 |
by (smt (verit) Pair_inject add_spmat.elims list.discI list.inject sorted_spvec.elims(1)) |
|
434 |
qed |
|
15009 | 435 |
|
31817 | 436 |
lemma sorted_spmat_add_spmat[rule_format]: "sorted_spmat A \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spmat (add_spmat A B)" |
437 |
apply (induct A B rule: add_spmat.induct) |
|
15009 | 438 |
apply (simp_all add: sorted_spvec_add_spvec) |
439 |
done |
|
440 |
||
38273 | 441 |
fun le_spvec :: "('a::lattice_ab_group_add) spvec \<Rightarrow> 'a spvec \<Rightarrow> bool" |
442 |
where |
|
31816 | 443 |
(* "measure (% (a,b). (length a) + (length b))" *) |
38273 | 444 |
"le_spvec [] [] = True" |
80736 | 445 |
| "le_spvec ((_,a)#as) [] = (a \<le> 0 & le_spvec as [])" |
446 |
| "le_spvec [] ((_,b)#bs) = (0 \<le> b & le_spvec [] bs)" |
|
38273 | 447 |
| "le_spvec ((i,a)#as) ((j,b)#bs) = ( |
80736 | 448 |
if (i < j) then a \<le> 0 & le_spvec as ((j,b)#bs) |
449 |
else if (j < i) then 0 \<le> b & le_spvec ((i,a)#as) bs |
|
450 |
else a \<le> b & le_spvec as bs)" |
|
15009 | 451 |
|
38273 | 452 |
fun le_spmat :: "('a::lattice_ab_group_add) spmat \<Rightarrow> 'a spmat \<Rightarrow> bool" |
453 |
where |
|
31816 | 454 |
(* "measure (% (a,b). (length a) + (length b))" *) |
38273 | 455 |
"le_spmat [] [] = True" |
456 |
| "le_spmat ((i,a)#as) [] = (le_spvec a [] & le_spmat as [])" |
|
457 |
| "le_spmat [] ((j,b)#bs) = (le_spvec [] b & le_spmat [] bs)" |
|
458 |
| "le_spmat ((i,a)#as) ((j,b)#bs) = ( |
|
459 |
if i < j then (le_spvec a [] & le_spmat as ((j,b)#bs)) |
|
460 |
else if j < i then (le_spvec [] b & le_spmat ((i,a)#as) bs) |
|
461 |
else (le_spvec a b & le_spmat as bs))" |
|
15009 | 462 |
|
35416
d8d7d1b785af
replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
haftmann
parents:
35028
diff
changeset
|
463 |
definition disj_matrices :: "('a::zero) matrix \<Rightarrow> 'a matrix \<Rightarrow> bool" where |
38273 | 464 |
"disj_matrices A B \<longleftrightarrow> |
67613 | 465 |
(\<forall>j i. (Rep_matrix A j i \<noteq> 0) \<longrightarrow> (Rep_matrix B j i = 0)) & (\<forall>j i. (Rep_matrix B j i \<noteq> 0) \<longrightarrow> (Rep_matrix A j i = 0))" |
15009 | 466 |
|
24124
4399175e3014
turned simp_depth_limit into configuration option;
wenzelm
parents:
23477
diff
changeset
|
467 |
declare [[simp_depth_limit = 6]] |
15009 | 468 |
|
15580 | 469 |
lemma disj_matrices_contr1: "disj_matrices A B \<Longrightarrow> Rep_matrix A j i \<noteq> 0 \<Longrightarrow> Rep_matrix B j i = 0" |
470 |
by (simp add: disj_matrices_def) |
|
471 |
||
472 |
lemma disj_matrices_contr2: "disj_matrices A B \<Longrightarrow> Rep_matrix B j i \<noteq> 0 \<Longrightarrow> Rep_matrix A j i = 0" |
|
473 |
by (simp add: disj_matrices_def) |
|
474 |
||
475 |
||
15009 | 476 |
lemma disj_matrices_add: "disj_matrices A B \<Longrightarrow> disj_matrices C D \<Longrightarrow> disj_matrices A D \<Longrightarrow> disj_matrices B C \<Longrightarrow> |
80736 | 477 |
(A + B \<le> C + D) = (A \<le> C & B \<le> (D::('a::lattice_ab_group_add) matrix))" |
15009 | 478 |
apply (auto) |
479 |
apply (simp (no_asm_use) only: le_matrix_def disj_matrices_def) |
|
480 |
apply (intro strip) |
|
481 |
apply (erule conjE)+ |
|
482 |
apply (drule_tac j=j and i=i in spec2)+ |
|
483 |
apply (case_tac "Rep_matrix B j i = 0") |
|
484 |
apply (case_tac "Rep_matrix D j i = 0") |
|
485 |
apply (simp_all) |
|
486 |
apply (simp (no_asm_use) only: le_matrix_def disj_matrices_def) |
|
487 |
apply (intro strip) |
|
488 |
apply (erule conjE)+ |
|
489 |
apply (drule_tac j=j and i=i in spec2)+ |
|
490 |
apply (case_tac "Rep_matrix A j i = 0") |
|
491 |
apply (case_tac "Rep_matrix C j i = 0") |
|
492 |
apply (simp_all) |
|
493 |
apply (erule add_mono) |
|
494 |
apply (assumption) |
|
495 |
done |
|
496 |
||
497 |
lemma disj_matrices_zero1[simp]: "disj_matrices 0 B" |
|
498 |
by (simp add: disj_matrices_def) |
|
499 |
||
500 |
lemma disj_matrices_zero2[simp]: "disj_matrices A 0" |
|
501 |
by (simp add: disj_matrices_def) |
|
502 |
||
503 |
lemma disj_matrices_commute: "disj_matrices A B = disj_matrices B A" |
|
80736 | 504 |
by (auto simp: disj_matrices_def) |
15009 | 505 |
|
506 |
lemma disj_matrices_add_le_zero: "disj_matrices A B \<Longrightarrow> |
|
80736 | 507 |
(A + B \<le> 0) = (A \<le> 0 & (B::('a::lattice_ab_group_add) matrix) \<le> 0)" |
15009 | 508 |
by (rule disj_matrices_add[of A B 0 0, simplified]) |
509 |
||
510 |
lemma disj_matrices_add_zero_le: "disj_matrices A B \<Longrightarrow> |
|
80736 | 511 |
(0 \<le> A + B) = (0 \<le> A & 0 \<le> (B::('a::lattice_ab_group_add) matrix))" |
15009 | 512 |
by (rule disj_matrices_add[of 0 0 A B, simplified]) |
513 |
||
514 |
lemma disj_matrices_add_x_le: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow> |
|
80736 | 515 |
(A \<le> B + C) = (A \<le> C & 0 \<le> (B::('a::lattice_ab_group_add) matrix))" |
516 |
by (auto simp: disj_matrices_add[of 0 A B C, simplified]) |
|
15009 | 517 |
|
518 |
lemma disj_matrices_add_le_x: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow> |
|
80736 | 519 |
(B + A \<le> C) = (A \<le> C & (B::('a::lattice_ab_group_add) matrix) \<le> 0)" |
520 |
by (auto simp: disj_matrices_add[of B A 0 C,simplified] disj_matrices_commute) |
|
15009 | 521 |
|
80736 | 522 |
lemma disj_sparse_row_singleton: "i \<le> j \<Longrightarrow> sorted_spvec((j,y)#v) \<Longrightarrow> disj_matrices (sparse_row_vector v) (singleton_matrix 0 i x)" |
15009 | 523 |
apply (simp add: disj_matrices_def) |
524 |
apply (rule conjI) |
|
525 |
apply (rule neg_imp) |
|
526 |
apply (simp) |
|
527 |
apply (intro strip) |
|
528 |
apply (rule sorted_sparse_row_vector_zero) |
|
529 |
apply (simp_all) |
|
530 |
apply (intro strip) |
|
531 |
apply (rule sorted_sparse_row_vector_zero) |
|
532 |
apply (simp_all) |
|
533 |
done |
|
534 |
||
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
535 |
lemma disj_matrices_x_add: "disj_matrices A B \<Longrightarrow> disj_matrices A C \<Longrightarrow> disj_matrices (A::('a::lattice_ab_group_add) matrix) (B+C)" |
15009 | 536 |
apply (simp add: disj_matrices_def) |
537 |
apply (auto) |
|
538 |
apply (drule_tac j=j and i=i in spec2)+ |
|
539 |
apply (case_tac "Rep_matrix B j i = 0") |
|
540 |
apply (case_tac "Rep_matrix C j i = 0") |
|
541 |
apply (simp_all) |
|
542 |
done |
|
543 |
||
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
544 |
lemma disj_matrices_add_x: "disj_matrices A B \<Longrightarrow> disj_matrices A C \<Longrightarrow> disj_matrices (B+C) (A::('a::lattice_ab_group_add) matrix)" |
15009 | 545 |
by (simp add: disj_matrices_x_add disj_matrices_commute) |
546 |
||
547 |
lemma disj_singleton_matrices[simp]: "disj_matrices (singleton_matrix j i x) (singleton_matrix u v y) = (j \<noteq> u | i \<noteq> v | x = 0 | y = 0)" |
|
80736 | 548 |
by (auto simp: disj_matrices_def) |
15009 | 549 |
|
550 |
lemma disj_move_sparse_vec_mat[simplified disj_matrices_commute]: |
|
80736 | 551 |
"j \<le> a \<Longrightarrow> sorted_spvec((a,c)#as) \<Longrightarrow> disj_matrices (move_matrix (sparse_row_vector b) (int j) i) (sparse_row_matrix as)" |
552 |
apply (auto simp: disj_matrices_def) |
|
15009 | 553 |
apply (drule nrows_notzero) |
554 |
apply (drule less_le_trans[OF _ nrows_spvec]) |
|
555 |
apply (subgoal_tac "ja = j") |
|
556 |
apply (simp add: sorted_sparse_row_matrix_zero) |
|
557 |
apply (arith) |
|
558 |
apply (rule nrows) |
|
559 |
apply (rule order_trans[of _ 1 _]) |
|
560 |
apply (simp) |
|
561 |
apply (case_tac "nat (int ja - int j) = 0") |
|
562 |
apply (case_tac "ja = j") |
|
563 |
apply (simp add: sorted_sparse_row_matrix_zero) |
|
564 |
apply arith+ |
|
565 |
done |
|
566 |
||
567 |
lemma disj_move_sparse_row_vector_twice: |
|
568 |
"j \<noteq> u \<Longrightarrow> disj_matrices (move_matrix (sparse_row_vector a) j i) (move_matrix (sparse_row_vector b) u v)" |
|
80736 | 569 |
apply (auto simp: disj_matrices_def) |
15009 | 570 |
apply (rule nrows, rule order_trans[of _ 1], simp, drule nrows_notzero, drule less_le_trans[OF _ nrows_spvec], arith)+ |
571 |
done |
|
572 |
||
80736 | 573 |
lemma le_spvec_iff_sparse_row_le[rule_format]: "(sorted_spvec a) \<longrightarrow> (sorted_spvec b) \<longrightarrow> (le_spvec a b) = (sparse_row_vector a \<le> sparse_row_vector b)" |
31817 | 574 |
apply (induct a b rule: le_spvec.induct) |
15178 | 575 |
apply (simp_all add: sorted_spvec_cons1 disj_matrices_add_le_zero disj_matrices_add_zero_le |
576 |
disj_sparse_row_singleton[OF order_refl] disj_matrices_commute) |
|
577 |
apply (rule conjI, intro strip) |
|
578 |
apply (simp add: sorted_spvec_cons1) |
|
579 |
apply (subst disj_matrices_add_x_le) |
|
580 |
apply (simp add: disj_sparse_row_singleton[OF less_imp_le] disj_matrices_x_add disj_matrices_commute) |
|
581 |
apply (simp add: disj_sparse_row_singleton[OF order_refl] disj_matrices_commute) |
|
582 |
apply (simp, blast) |
|
583 |
apply (intro strip, rule conjI, intro strip) |
|
584 |
apply (simp add: sorted_spvec_cons1) |
|
585 |
apply (subst disj_matrices_add_le_x) |
|
586 |
apply (simp_all add: disj_sparse_row_singleton[OF order_refl] disj_sparse_row_singleton[OF less_imp_le] disj_matrices_commute disj_matrices_x_add) |
|
587 |
apply (blast) |
|
588 |
apply (intro strip) |
|
589 |
apply (simp add: sorted_spvec_cons1) |
|
31816 | 590 |
apply (case_tac "a=b", simp_all) |
15178 | 591 |
apply (subst disj_matrices_add) |
592 |
apply (simp_all add: disj_sparse_row_singleton[OF order_refl] disj_matrices_commute) |
|
15009 | 593 |
done |
594 |
||
80736 | 595 |
lemma le_spvec_empty2_sparse_row[rule_format]: "sorted_spvec b \<longrightarrow> le_spvec b [] = (sparse_row_vector b \<le> 0)" |
15009 | 596 |
apply (induct b) |
597 |
apply (simp_all add: sorted_spvec_cons1) |
|
598 |
apply (intro strip) |
|
599 |
apply (subst disj_matrices_add_le_zero) |
|
80736 | 600 |
apply (auto simp: disj_matrices_commute disj_sparse_row_singleton[OF order_refl] sorted_spvec_cons1) |
15009 | 601 |
done |
602 |
||
80736 | 603 |
lemma le_spvec_empty1_sparse_row[rule_format]: "(sorted_spvec b) \<longrightarrow> (le_spvec [] b = (0 \<le> sparse_row_vector b))" |
15009 | 604 |
apply (induct b) |
605 |
apply (simp_all add: sorted_spvec_cons1) |
|
606 |
apply (intro strip) |
|
607 |
apply (subst disj_matrices_add_zero_le) |
|
80736 | 608 |
apply (auto simp: disj_matrices_commute disj_sparse_row_singleton[OF order_refl] sorted_spvec_cons1) |
15009 | 609 |
done |
610 |
||
611 |
lemma le_spmat_iff_sparse_row_le[rule_format]: "(sorted_spvec A) \<longrightarrow> (sorted_spmat A) \<longrightarrow> (sorted_spvec B) \<longrightarrow> (sorted_spmat B) \<longrightarrow> |
|
80736 | 612 |
le_spmat A B = (sparse_row_matrix A \<le> sparse_row_matrix B)" |
31817 | 613 |
apply (induct A B rule: le_spmat.induct) |
15009 | 614 |
apply (simp add: sparse_row_matrix_cons disj_matrices_add_le_zero disj_matrices_add_zero_le disj_move_sparse_vec_mat[OF order_refl] |
615 |
disj_matrices_commute sorted_spvec_cons1 le_spvec_empty2_sparse_row le_spvec_empty1_sparse_row)+ |
|
616 |
apply (rule conjI, intro strip) |
|
617 |
apply (simp add: sorted_spvec_cons1) |
|
618 |
apply (subst disj_matrices_add_x_le) |
|
619 |
apply (rule disj_matrices_add_x) |
|
620 |
apply (simp add: disj_move_sparse_row_vector_twice) |
|
621 |
apply (simp add: disj_move_sparse_vec_mat[OF less_imp_le] disj_matrices_commute) |
|
622 |
apply (simp add: disj_move_sparse_vec_mat[OF order_refl] disj_matrices_commute) |
|
623 |
apply (simp, blast) |
|
624 |
apply (intro strip, rule conjI, intro strip) |
|
625 |
apply (simp add: sorted_spvec_cons1) |
|
626 |
apply (subst disj_matrices_add_le_x) |
|
627 |
apply (simp add: disj_move_sparse_vec_mat[OF order_refl]) |
|
628 |
apply (rule disj_matrices_x_add) |
|
629 |
apply (simp add: disj_move_sparse_row_vector_twice) |
|
630 |
apply (simp add: disj_move_sparse_vec_mat[OF less_imp_le] disj_matrices_commute) |
|
631 |
apply (simp, blast) |
|
632 |
apply (intro strip) |
|
31816 | 633 |
apply (case_tac "i=j") |
15009 | 634 |
apply (simp_all) |
635 |
apply (subst disj_matrices_add) |
|
636 |
apply (simp_all add: disj_matrices_commute disj_move_sparse_vec_mat[OF order_refl]) |
|
637 |
apply (simp add: sorted_spvec_cons1 le_spvec_iff_sparse_row_le) |
|
638 |
done |
|
639 |
||
24124
4399175e3014
turned simp_depth_limit into configuration option;
wenzelm
parents:
23477
diff
changeset
|
640 |
declare [[simp_depth_limit = 999]] |
15178 | 641 |
|
38273 | 642 |
primrec abs_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat" |
643 |
where |
|
644 |
"abs_spmat [] = []" |
|
645 |
| "abs_spmat (a#as) = (fst a, abs_spvec (snd a))#(abs_spmat as)" |
|
15178 | 646 |
|
38273 | 647 |
primrec minus_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat" |
648 |
where |
|
649 |
"minus_spmat [] = []" |
|
650 |
| "minus_spmat (a#as) = (fst a, minus_spvec (snd a))#(minus_spmat as)" |
|
15178 | 651 |
|
652 |
lemma sparse_row_matrix_minus: |
|
653 |
"sparse_row_matrix (minus_spmat A) = - (sparse_row_matrix A)" |
|
80736 | 654 |
proof (induct A) |
655 |
case Nil |
|
656 |
then show ?case by auto |
|
657 |
next |
|
658 |
case (Cons a A) |
|
659 |
then show ?case |
|
660 |
by (simp add: sparse_row_vector_minus sparse_row_matrix_cons matrix_eqI) |
|
661 |
qed |
|
15009 | 662 |
|
80736 | 663 |
lemma Rep_sparse_row_vector_zero: |
664 |
assumes "x \<noteq> 0" |
|
665 |
shows "Rep_matrix (sparse_row_vector v) x y = 0" |
|
666 |
by (metis Suc_leI assms le0 le_eq_less_or_eq nrows_le nrows_spvec) |
|
15178 | 667 |
|
668 |
lemma sparse_row_matrix_abs: |
|
61945 | 669 |
"sorted_spvec A \<Longrightarrow> sorted_spmat A \<Longrightarrow> sparse_row_matrix (abs_spmat A) = \<bar>sparse_row_matrix A\<bar>" |
80736 | 670 |
proof (induct A) |
671 |
case Nil |
|
672 |
then show ?case by auto |
|
673 |
next |
|
674 |
case (Cons ab A) |
|
675 |
then have A: "sorted_spvec A" |
|
676 |
using sorted_spvec_cons1 by blast |
|
677 |
show ?case |
|
678 |
proof (cases ab) |
|
679 |
case (Pair a b) |
|
680 |
show ?thesis |
|
681 |
unfolding Pair |
|
682 |
proof (intro matrix_eqI) |
|
683 |
fix m n |
|
684 |
show "Rep_matrix (sparse_row_matrix (abs_spmat ((a,b) # A))) m n |
|
685 |
= Rep_matrix \<bar>sparse_row_matrix ((a,b) # A)\<bar> m n" |
|
686 |
using Cons Pair A |
|
687 |
apply (simp add: sparse_row_vector_abs sparse_row_matrix_cons) |
|
688 |
apply (cases "m=a") |
|
689 |
using sorted_sparse_row_matrix_zero apply fastforce |
|
690 |
by (simp add: Rep_sparse_row_vector_zero) |
|
691 |
qed |
|
692 |
qed |
|
693 |
qed |
|
15178 | 694 |
|
695 |
lemma sorted_spvec_minus_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (minus_spmat A)" |
|
80736 | 696 |
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps) |
15178 | 697 |
|
698 |
lemma sorted_spvec_abs_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (abs_spmat A)" |
|
80736 | 699 |
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps) |
15178 | 700 |
|
701 |
lemma sorted_spmat_minus_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (minus_spmat A)" |
|
80736 | 702 |
by (induct A) (simp_all add: sorted_spvec_minus_spvec) |
15178 | 703 |
|
704 |
lemma sorted_spmat_abs_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (abs_spmat A)" |
|
80736 | 705 |
by (induct A) (simp_all add: sorted_spvec_abs_spvec) |
15009 | 706 |
|
38273 | 707 |
definition diff_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" |
708 |
where "diff_spmat A B = add_spmat A (minus_spmat B)" |
|
15178 | 709 |
|
710 |
lemma sorted_spmat_diff_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spmat (diff_spmat A B)" |
|
711 |
by (simp add: diff_spmat_def sorted_spmat_minus_spmat sorted_spmat_add_spmat) |
|
712 |
||
713 |
lemma sorted_spvec_diff_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec B \<Longrightarrow> sorted_spvec (diff_spmat A B)" |
|
714 |
by (simp add: diff_spmat_def sorted_spvec_minus_spmat sorted_spvec_add_spmat) |
|
715 |
||
716 |
lemma sparse_row_diff_spmat: "sparse_row_matrix (diff_spmat A B ) = (sparse_row_matrix A) - (sparse_row_matrix B)" |
|
717 |
by (simp add: diff_spmat_def sparse_row_add_spmat sparse_row_matrix_minus) |
|
718 |
||
38273 | 719 |
definition sorted_sparse_matrix :: "'a spmat \<Rightarrow> bool" |
720 |
where "sorted_sparse_matrix A \<longleftrightarrow> sorted_spvec A & sorted_spmat A" |
|
15178 | 721 |
|
722 |
lemma sorted_sparse_matrix_imp_spvec: "sorted_sparse_matrix A \<Longrightarrow> sorted_spvec A" |
|
723 |
by (simp add: sorted_sparse_matrix_def) |
|
724 |
||
725 |
lemma sorted_sparse_matrix_imp_spmat: "sorted_sparse_matrix A \<Longrightarrow> sorted_spmat A" |
|
726 |
by (simp add: sorted_sparse_matrix_def) |
|
727 |
||
728 |
lemmas sorted_sp_simps = |
|
729 |
sorted_spvec.simps |
|
730 |
sorted_spmat.simps |
|
731 |
sorted_sparse_matrix_def |
|
732 |
||
733 |
lemma bool1: "(\<not> True) = False" by blast |
|
734 |
lemma bool2: "(\<not> False) = True" by blast |
|
61076 | 735 |
lemma bool3: "((P::bool) \<and> True) = P" by blast |
736 |
lemma bool4: "(True \<and> (P::bool)) = P" by blast |
|
737 |
lemma bool5: "((P::bool) \<and> False) = False" by blast |
|
738 |
lemma bool6: "(False \<and> (P::bool)) = False" by blast |
|
739 |
lemma bool7: "((P::bool) \<or> True) = True" by blast |
|
740 |
lemma bool8: "(True \<or> (P::bool)) = True" by blast |
|
741 |
lemma bool9: "((P::bool) \<or> False) = P" by blast |
|
742 |
lemma bool10: "(False \<or> (P::bool)) = P" by blast |
|
15178 | 743 |
lemmas boolarith = bool1 bool2 bool3 bool4 bool5 bool6 bool7 bool8 bool9 bool10 |
744 |
||
745 |
lemma if_case_eq: "(if b then x else y) = (case b of True => x | False => y)" by simp |
|
746 |
||
38273 | 747 |
primrec pprt_spvec :: "('a::{lattice_ab_group_add}) spvec \<Rightarrow> 'a spvec" |
748 |
where |
|
749 |
"pprt_spvec [] = []" |
|
750 |
| "pprt_spvec (a#as) = (fst a, pprt (snd a)) # (pprt_spvec as)" |
|
15580 | 751 |
|
38273 | 752 |
primrec nprt_spvec :: "('a::{lattice_ab_group_add}) spvec \<Rightarrow> 'a spvec" |
753 |
where |
|
15580 | 754 |
"nprt_spvec [] = []" |
38273 | 755 |
| "nprt_spvec (a#as) = (fst a, nprt (snd a)) # (nprt_spvec as)" |
15580 | 756 |
|
38273 | 757 |
primrec pprt_spmat :: "('a::{lattice_ab_group_add}) spmat \<Rightarrow> 'a spmat" |
758 |
where |
|
15580 | 759 |
"pprt_spmat [] = []" |
38273 | 760 |
| "pprt_spmat (a#as) = (fst a, pprt_spvec (snd a))#(pprt_spmat as)" |
15580 | 761 |
|
38273 | 762 |
primrec nprt_spmat :: "('a::{lattice_ab_group_add}) spmat \<Rightarrow> 'a spmat" |
763 |
where |
|
15580 | 764 |
"nprt_spmat [] = []" |
38273 | 765 |
| "nprt_spmat (a#as) = (fst a, nprt_spvec (snd a))#(nprt_spmat as)" |
15580 | 766 |
|
767 |
||
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
768 |
lemma pprt_add: "disj_matrices A (B::(_::lattice_ring) matrix) \<Longrightarrow> pprt (A+B) = pprt A + pprt B" |
22452
8a86fd2a1bf0
adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
haftmann
parents:
20432
diff
changeset
|
769 |
apply (simp add: pprt_def sup_matrix_def) |
80736 | 770 |
apply (intro matrix_eqI) |
771 |
by (smt (verit, del_insts) Rep_combine_matrix Rep_zero_matrix_def add.commute comm_monoid_add_class.add_0 disj_matrices_def plus_matrix_def sup.idem) |
|
15580 | 772 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
773 |
lemma nprt_add: "disj_matrices A (B::(_::lattice_ring) matrix) \<Longrightarrow> nprt (A+B) = nprt A + nprt B" |
80736 | 774 |
unfolding nprt_def inf_matrix_def |
775 |
apply (intro matrix_eqI) |
|
776 |
by (smt (verit, ccfv_threshold) Rep_combine_matrix Rep_matrix_add add.commute add_cancel_right_right add_eq_inf_sup disj_matrices_contr2 sup.idem) |
|
15580 | 777 |
|
80736 | 778 |
lemma pprt_singleton[simp]: |
779 |
fixes x:: "_::lattice_ring" |
|
780 |
shows "pprt (singleton_matrix j i x) = singleton_matrix j i (pprt x)" |
|
781 |
unfolding pprt_def sup_matrix_def |
|
782 |
by (simp add: matrix_eqI) |
|
15580 | 783 |
|
80736 | 784 |
lemma nprt_singleton[simp]: |
785 |
fixes x:: "_::lattice_ring" |
|
786 |
shows "nprt (singleton_matrix j i x) = singleton_matrix j i (nprt x)" |
|
787 |
by (metis add_left_imp_eq pprt_singleton prts singleton_matrix_add) |
|
15580 | 788 |
|
80736 | 789 |
lemma sparse_row_vector_pprt: |
790 |
fixes v:: "_::lattice_ring spvec" |
|
791 |
shows "sorted_spvec v \<Longrightarrow> sparse_row_vector (pprt_spvec v) = pprt (sparse_row_vector v)" |
|
792 |
proof (induct v rule: sorted_spvec.induct) |
|
793 |
case (3 m x n y bs) |
|
794 |
then show ?case |
|
795 |
apply (simp add: ) |
|
796 |
apply (subst pprt_add) |
|
797 |
apply (metis disj_matrices_commute disj_sparse_row_singleton order.refl fst_conv prod.sel(2) sparse_row_vector_cons) |
|
798 |
by (metis pprt_singleton sorted_spvec_cons1) |
|
799 |
qed auto |
|
15580 | 800 |
|
80736 | 801 |
lemma sparse_row_vector_nprt: |
802 |
fixes v:: "_::lattice_ring spvec" |
|
803 |
shows "sorted_spvec v \<Longrightarrow> sparse_row_vector (nprt_spvec v) = nprt (sparse_row_vector v)" |
|
804 |
proof (induct v rule: sorted_spvec.induct) |
|
805 |
case (3 m x n y bs) |
|
806 |
then show ?case |
|
807 |
apply (simp add: ) |
|
808 |
apply (subst nprt_add) |
|
809 |
apply (metis disj_matrices_commute disj_sparse_row_singleton dual_order.refl fst_conv prod.sel(2) sparse_row_vector_cons) |
|
810 |
using sorted_spvec_cons1 by force |
|
811 |
qed auto |
|
15580 | 812 |
|
813 |
||
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
814 |
lemma pprt_move_matrix: "pprt (move_matrix (A::('a::lattice_ring) matrix) j i) = move_matrix (pprt A) j i" |
80736 | 815 |
by (simp add: pprt_def sup_matrix_def matrix_eqI) |
15580 | 816 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
817 |
lemma nprt_move_matrix: "nprt (move_matrix (A::('a::lattice_ring) matrix) j i) = move_matrix (nprt A) j i" |
80736 | 818 |
by (simp add: nprt_def inf_matrix_def matrix_eqI) |
15580 | 819 |
|
80736 | 820 |
lemma sparse_row_matrix_pprt: |
821 |
fixes m:: "'a::lattice_ring spmat" |
|
822 |
shows "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (pprt_spmat m) = pprt (sparse_row_matrix m)" |
|
823 |
proof (induct m rule: sorted_spvec.induct) |
|
824 |
case (2 a) |
|
825 |
then show ?case |
|
826 |
by (simp add: pprt_move_matrix sparse_row_matrix_cons sparse_row_vector_pprt) |
|
827 |
next |
|
828 |
case (3 m x n y bs) |
|
829 |
then show ?case |
|
830 |
apply (simp add: sparse_row_matrix_cons sparse_row_vector_pprt) |
|
831 |
apply (subst pprt_add) |
|
832 |
apply (subst disj_matrices_commute) |
|
833 |
apply (metis disj_move_sparse_vec_mat eq_imp_le fst_conv prod.sel(2) sparse_row_matrix_cons) |
|
834 |
apply (simp add: sorted_spvec.simps pprt_move_matrix) |
|
835 |
done |
|
836 |
qed auto |
|
15580 | 837 |
|
80736 | 838 |
lemma sparse_row_matrix_nprt: |
839 |
fixes m:: "'a::lattice_ring spmat" |
|
840 |
shows "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (nprt_spmat m) = nprt (sparse_row_matrix m)" |
|
841 |
proof (induct m rule: sorted_spvec.induct) |
|
842 |
case (2 a) |
|
843 |
then show ?case |
|
844 |
by (simp add: nprt_move_matrix sparse_row_matrix_cons sparse_row_vector_nprt) |
|
845 |
next |
|
846 |
case (3 m x n y bs) |
|
847 |
then show ?case |
|
848 |
apply (simp add: sparse_row_matrix_cons sparse_row_vector_nprt) |
|
849 |
apply (subst nprt_add) |
|
850 |
apply (subst disj_matrices_commute) |
|
851 |
apply (metis disj_move_sparse_vec_mat fst_conv nle_le prod.sel(2) sparse_row_matrix_cons) |
|
852 |
apply (simp add: sorted_spvec.simps nprt_move_matrix) |
|
853 |
done |
|
854 |
qed auto |
|
15580 | 855 |
|
856 |
lemma sorted_pprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (pprt_spvec v)" |
|
80736 | 857 |
proof (induct v rule: sorted_spvec.induct) |
858 |
case 1 |
|
859 |
then show ?case by auto |
|
860 |
next |
|
861 |
case (2 a) |
|
862 |
then show ?case |
|
863 |
by (simp add: sorted_spvec_step1) |
|
864 |
next |
|
865 |
case (3 m x n y bs) |
|
866 |
then show ?case |
|
867 |
by (simp add: sorted_spvec_step) |
|
868 |
qed |
|
15580 | 869 |
|
870 |
lemma sorted_nprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (nprt_spvec v)" |
|
80736 | 871 |
by (induct v rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm) |
15580 | 872 |
|
873 |
lemma sorted_spvec_pprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (pprt_spmat m)" |
|
80736 | 874 |
by (induct m rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm) |
15580 | 875 |
|
876 |
lemma sorted_spvec_nprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (nprt_spmat m)" |
|
80736 | 877 |
by (induct m rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm) |
15580 | 878 |
|
879 |
lemma sorted_spmat_pprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (pprt_spmat m)" |
|
80736 | 880 |
by (induct m) (simp_all add: sorted_pprt_spvec) |
15580 | 881 |
|
882 |
lemma sorted_spmat_nprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (nprt_spmat m)" |
|
80736 | 883 |
by (induct m) (simp_all add: sorted_nprt_spvec) |
15580 | 884 |
|
35416
d8d7d1b785af
replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
haftmann
parents:
35028
diff
changeset
|
885 |
definition mult_est_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" where |
38273 | 886 |
"mult_est_spmat r1 r2 s1 s2 = |
31816 | 887 |
add_spmat (mult_spmat (pprt_spmat s2) (pprt_spmat r2)) (add_spmat (mult_spmat (pprt_spmat s1) (nprt_spmat r2)) |
888 |
(add_spmat (mult_spmat (nprt_spmat s2) (pprt_spmat r1)) (mult_spmat (nprt_spmat s1) (nprt_spmat r1))))" |
|
15580 | 889 |
|
890 |
lemmas sparse_row_matrix_op_simps = |
|
891 |
sorted_sparse_matrix_imp_spmat sorted_sparse_matrix_imp_spvec |
|
892 |
sparse_row_add_spmat sorted_spvec_add_spmat sorted_spmat_add_spmat |
|
893 |
sparse_row_diff_spmat sorted_spvec_diff_spmat sorted_spmat_diff_spmat |
|
894 |
sparse_row_matrix_minus sorted_spvec_minus_spmat sorted_spmat_minus_spmat |
|
895 |
sparse_row_mult_spmat sorted_spvec_mult_spmat sorted_spmat_mult_spmat |
|
896 |
sparse_row_matrix_abs sorted_spvec_abs_spmat sorted_spmat_abs_spmat |
|
897 |
le_spmat_iff_sparse_row_le |
|
898 |
sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat |
|
899 |
sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat |
|
900 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46988
diff
changeset
|
901 |
lemmas sparse_row_matrix_arith_simps = |
15580 | 902 |
mult_spmat.simps mult_spvec_spmat.simps |
903 |
addmult_spvec.simps |
|
904 |
smult_spvec_empty smult_spvec_cons |
|
905 |
add_spmat.simps add_spvec.simps |
|
906 |
minus_spmat.simps minus_spvec.simps |
|
907 |
abs_spmat.simps abs_spvec.simps |
|
908 |
diff_spmat_def |
|
909 |
le_spmat.simps le_spvec.simps |
|
910 |
pprt_spmat.simps pprt_spvec.simps |
|
911 |
nprt_spmat.simps nprt_spvec.simps |
|
912 |
mult_est_spmat_def |
|
913 |
||
914 |
||
915 |
(*lemma spm_linprog_dual_estimate_1: |
|
15178 | 916 |
assumes |
917 |
"sorted_sparse_matrix A1" |
|
918 |
"sorted_sparse_matrix A2" |
|
919 |
"sorted_sparse_matrix c1" |
|
920 |
"sorted_sparse_matrix c2" |
|
921 |
"sorted_sparse_matrix y" |
|
922 |
"sorted_spvec b" |
|
923 |
"sorted_spvec r" |
|
924 |
"le_spmat ([], y)" |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
925 |
"A * x \<le> sparse_row_matrix (b::('a::lattice_ring) spmat)" |
80736 | 926 |
"sparse_row_matrix A1 \<le> A" |
927 |
"A \<le> sparse_row_matrix A2" |
|
928 |
"sparse_row_matrix c1 \<le> c" |
|
929 |
"c \<le> sparse_row_matrix c2" |
|
61945 | 930 |
"\<bar>x\<bar> \<le> sparse_row_matrix r" |
15178 | 931 |
shows |
932 |
"c * x \<le> sparse_row_matrix (add_spmat (mult_spmat y b, mult_spmat (add_spmat (add_spmat (mult_spmat y (diff_spmat A2 A1), |
|
933 |
abs_spmat (diff_spmat (mult_spmat y A1) c1)), diff_spmat c2 c1)) r))" |
|
934 |
by (insert prems, simp add: sparse_row_matrix_op_simps linprog_dual_estimate_1[where A=A]) |
|
15580 | 935 |
*) |
15009 | 936 |
|
937 |
end |