author | haftmann |
Thu, 19 Jun 2025 17:15:40 +0200 | |
changeset 82734 | 89347c0cc6a3 |
parent 80756 | 4d592706086e |
permissions | -rw-r--r-- |
47455 | 1 |
(* Title: HOL/Matrix_LP/SparseMatrix.thy |
80756 | 2 |
Author: Steven Obua; updated to Isar by LCP |
16487 | 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)) |
|
80756 | 294 |
apply simp |
80736 | 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)" |
80756 | 437 |
by (induct A B rule: add_spmat.induct) (simp_all add: sorted_spvec_add_spvec) |
15009 | 438 |
|
38273 | 439 |
fun le_spvec :: "('a::lattice_ab_group_add) spvec \<Rightarrow> 'a spvec \<Rightarrow> bool" |
440 |
where |
|
31816 | 441 |
(* "measure (% (a,b). (length a) + (length b))" *) |
38273 | 442 |
"le_spvec [] [] = True" |
80736 | 443 |
| "le_spvec ((_,a)#as) [] = (a \<le> 0 & le_spvec as [])" |
444 |
| "le_spvec [] ((_,b)#bs) = (0 \<le> b & le_spvec [] bs)" |
|
38273 | 445 |
| "le_spvec ((i,a)#as) ((j,b)#bs) = ( |
80736 | 446 |
if (i < j) then a \<le> 0 & le_spvec as ((j,b)#bs) |
447 |
else if (j < i) then 0 \<le> b & le_spvec ((i,a)#as) bs |
|
448 |
else a \<le> b & le_spvec as bs)" |
|
15009 | 449 |
|
38273 | 450 |
fun le_spmat :: "('a::lattice_ab_group_add) spmat \<Rightarrow> 'a spmat \<Rightarrow> bool" |
451 |
where |
|
31816 | 452 |
(* "measure (% (a,b). (length a) + (length b))" *) |
38273 | 453 |
"le_spmat [] [] = True" |
454 |
| "le_spmat ((i,a)#as) [] = (le_spvec a [] & le_spmat as [])" |
|
455 |
| "le_spmat [] ((j,b)#bs) = (le_spvec [] b & le_spmat [] bs)" |
|
456 |
| "le_spmat ((i,a)#as) ((j,b)#bs) = ( |
|
457 |
if i < j then (le_spvec a [] & le_spmat as ((j,b)#bs)) |
|
458 |
else if j < i then (le_spvec [] b & le_spmat ((i,a)#as) bs) |
|
459 |
else (le_spvec a b & le_spmat as bs))" |
|
15009 | 460 |
|
35416
d8d7d1b785af
replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
haftmann
parents:
35028
diff
changeset
|
461 |
definition disj_matrices :: "('a::zero) matrix \<Rightarrow> 'a matrix \<Rightarrow> bool" where |
38273 | 462 |
"disj_matrices A B \<longleftrightarrow> |
67613 | 463 |
(\<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 | 464 |
|
15580 | 465 |
lemma disj_matrices_contr1: "disj_matrices A B \<Longrightarrow> Rep_matrix A j i \<noteq> 0 \<Longrightarrow> Rep_matrix B j i = 0" |
466 |
by (simp add: disj_matrices_def) |
|
467 |
||
468 |
lemma disj_matrices_contr2: "disj_matrices A B \<Longrightarrow> Rep_matrix B j i \<noteq> 0 \<Longrightarrow> Rep_matrix A j i = 0" |
|
469 |
by (simp add: disj_matrices_def) |
|
470 |
||
471 |
||
80756 | 472 |
lemma disj_matrices_add: |
473 |
fixes A :: "('a::lattice_ab_group_add) matrix" |
|
474 |
shows "disj_matrices A B \<Longrightarrow> disj_matrices C D \<Longrightarrow> disj_matrices A D |
|
475 |
\<Longrightarrow> disj_matrices B C \<Longrightarrow> (A + B \<le> C + D) = (A \<le> C \<and> B \<le> D)" |
|
476 |
apply (intro iffI conjI) |
|
477 |
unfolding le_matrix_def disj_matrices_def |
|
478 |
apply (metis Rep_matrix_add group_cancel.rule0 order_refl) |
|
479 |
apply (metis (no_types, lifting) Rep_matrix_add add_cancel_right_left dual_order.refl) |
|
480 |
by (meson add_mono le_matrix_def) |
|
15009 | 481 |
|
482 |
lemma disj_matrices_zero1[simp]: "disj_matrices 0 B" |
|
80756 | 483 |
by (simp add: disj_matrices_def) |
15009 | 484 |
|
485 |
lemma disj_matrices_zero2[simp]: "disj_matrices A 0" |
|
80756 | 486 |
by (simp add: disj_matrices_def) |
15009 | 487 |
|
488 |
lemma disj_matrices_commute: "disj_matrices A B = disj_matrices B A" |
|
80756 | 489 |
by (auto simp: disj_matrices_def) |
15009 | 490 |
|
491 |
lemma disj_matrices_add_le_zero: "disj_matrices A B \<Longrightarrow> |
|
80736 | 492 |
(A + B \<le> 0) = (A \<le> 0 & (B::('a::lattice_ab_group_add) matrix) \<le> 0)" |
80756 | 493 |
by (rule disj_matrices_add[of A B 0 0, simplified]) |
494 |
||
15009 | 495 |
lemma disj_matrices_add_zero_le: "disj_matrices A B \<Longrightarrow> |
80736 | 496 |
(0 \<le> A + B) = (0 \<le> A & 0 \<le> (B::('a::lattice_ab_group_add) matrix))" |
80756 | 497 |
by (rule disj_matrices_add[of 0 0 A B, simplified]) |
15009 | 498 |
|
499 |
lemma disj_matrices_add_x_le: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow> |
|
80736 | 500 |
(A \<le> B + C) = (A \<le> C & 0 \<le> (B::('a::lattice_ab_group_add) matrix))" |
80756 | 501 |
by (auto simp: disj_matrices_add[of 0 A B C, simplified]) |
15009 | 502 |
|
503 |
lemma disj_matrices_add_le_x: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow> |
|
80736 | 504 |
(B + A \<le> C) = (A \<le> C & (B::('a::lattice_ab_group_add) matrix) \<le> 0)" |
80756 | 505 |
by (auto simp: disj_matrices_add[of B A 0 C,simplified] disj_matrices_commute) |
15009 | 506 |
|
80736 | 507 |
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 | 508 |
apply (simp add: disj_matrices_def) |
80756 | 509 |
using sorted_sparse_row_vector_zero by blast |
15009 | 510 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
511 |
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)" |
80756 | 512 |
by (smt (verit, ccfv_SIG) Rep_matrix_add add_0 disj_matrices_def) |
15009 | 513 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
514 |
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 | 515 |
by (simp add: disj_matrices_x_add disj_matrices_commute) |
516 |
||
517 |
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 | 518 |
by (auto simp: disj_matrices_def) |
15009 | 519 |
|
80756 | 520 |
lemma disj_move_sparse_vec_mat: |
521 |
assumes "j \<le> a" and "sorted_spvec ((a, c) # as)" |
|
522 |
shows "disj_matrices (sparse_row_matrix as) (move_matrix (sparse_row_vector b) (int j) i)" |
|
523 |
proof - |
|
524 |
have "Rep_matrix (sparse_row_vector b) (n-j) (nat (int m - i)) = 0" |
|
525 |
if "\<not> n<j" and nz: "Rep_matrix (sparse_row_matrix as) n m \<noteq> 0" |
|
526 |
for n m |
|
527 |
proof - |
|
528 |
have "n \<noteq> j" |
|
529 |
using assms sorted_sparse_row_matrix_zero nz by blast |
|
530 |
with that have "j < n" by auto |
|
531 |
then show ?thesis |
|
532 |
by (metis One_nat_def Suc_diff_Suc nrows nrows_spvec plus_1_eq_Suc trans_le_add1) |
|
533 |
qed |
|
534 |
then show ?thesis |
|
535 |
by (auto simp: disj_matrices_def nat_minus_as_int) |
|
536 |
qed |
|
15009 | 537 |
|
538 |
lemma disj_move_sparse_row_vector_twice: |
|
539 |
"j \<noteq> u \<Longrightarrow> disj_matrices (move_matrix (sparse_row_vector a) j i) (move_matrix (sparse_row_vector b) u v)" |
|
80756 | 540 |
unfolding disj_matrices_def |
541 |
by (smt (verit, ccfv_SIG) One_nat_def Rep_move_matrix of_nat_1 le_nat_iff nrows nrows_spvec of_nat_le_iff) |
|
15009 | 542 |
|
80756 | 543 |
lemma le_spvec_iff_sparse_row_le: |
544 |
"sorted_spvec a \<Longrightarrow> sorted_spvec b \<Longrightarrow> (le_spvec a b) \<longleftrightarrow> (sparse_row_vector a \<le> sparse_row_vector b)" |
|
545 |
proof (induct a b rule: le_spvec.induct) |
|
546 |
case 1 |
|
547 |
then show ?case |
|
548 |
by auto |
|
549 |
next |
|
550 |
case (2 uu a as) |
|
551 |
then have "sorted_spvec as" |
|
552 |
by (metis sorted_spvec_cons1) |
|
553 |
with 2 show ?case |
|
554 |
apply (simp add: add.commute) |
|
555 |
by (metis disj_matrices_add_le_zero disj_sparse_row_singleton le_refl singleton_le_zero) |
|
556 |
next |
|
557 |
case (3 uv b bs) |
|
558 |
then have "sorted_spvec bs" |
|
559 |
by (metis sorted_spvec_cons1) |
|
560 |
with 3 show ?case |
|
561 |
apply (simp add: add.commute) |
|
562 |
by (metis disj_matrices_add_zero_le disj_sparse_row_singleton le_refl singleton_ge_zero) |
|
563 |
next |
|
564 |
case (4 i a as j b bs) |
|
565 |
then obtain \<section>: "sorted_spvec as" "sorted_spvec bs" |
|
566 |
by (metis sorted_spvec_cons1) |
|
567 |
show ?case |
|
568 |
proof (cases i j rule: linorder_cases) |
|
569 |
case less |
|
570 |
with 4 \<section> show ?thesis |
|
571 |
apply (simp add: ) |
|
572 |
by (metis disj_matrices_add_le_x disj_matrices_add_x disj_matrices_commute disj_singleton_matrices disj_sparse_row_singleton less_imp_le_nat singleton_le_zero not_le) |
|
573 |
next |
|
574 |
case equal |
|
575 |
with 4 \<section> show ?thesis |
|
576 |
apply (simp add: ) |
|
577 |
by (metis disj_matrices_add disj_matrices_commute disj_sparse_row_singleton order_refl singleton_matrix_le) |
|
578 |
next |
|
579 |
case greater |
|
580 |
with 4 \<section> show ?thesis |
|
581 |
apply (simp add: ) |
|
582 |
by (metis disj_matrices_add_x disj_matrices_add_x_le disj_matrices_commute disj_singleton_matrices disj_sparse_row_singleton le_refl order_less_le singleton_ge_zero) |
|
583 |
qed |
|
584 |
qed |
|
15009 | 585 |
|
80756 | 586 |
lemma le_spvec_empty2_sparse_row: |
587 |
"sorted_spvec b \<Longrightarrow> le_spvec b [] = (sparse_row_vector b \<le> 0)" |
|
588 |
by (simp add: le_spvec_iff_sparse_row_le) |
|
589 |
||
590 |
lemma le_spvec_empty1_sparse_row: |
|
591 |
"(sorted_spvec b) \<Longrightarrow> (le_spvec [] b = (0 \<le> sparse_row_vector b))" |
|
592 |
by (simp add: le_spvec_iff_sparse_row_le) |
|
593 |
||
594 |
lemma le_spmat_iff_sparse_row_le: |
|
595 |
"\<lbrakk>sorted_spvec A; sorted_spmat A; sorted_spvec B; sorted_spmat B\<rbrakk> \<Longrightarrow> |
|
80736 | 596 |
le_spmat A B = (sparse_row_matrix A \<le> sparse_row_matrix B)" |
80756 | 597 |
proof (induct A B rule: le_spmat.induct) |
598 |
case (4 i a as j b bs) |
|
599 |
then obtain \<section>: "sorted_spvec as" "sorted_spvec bs" |
|
600 |
by (metis sorted_spvec_cons1) |
|
601 |
show ?case |
|
602 |
proof (cases i j rule: linorder_cases) |
|
603 |
case less |
|
604 |
with 4 \<section> show ?thesis |
|
605 |
apply (simp add: sparse_row_matrix_cons le_spvec_empty2_sparse_row) |
|
606 |
by (metis disj_matrices_add_le_x disj_matrices_add_x disj_matrices_commute disj_move_sparse_row_vector_twice disj_move_sparse_vec_mat int_eq_iff less_not_refl move_matrix_le_zero order_le_less) |
|
607 |
next |
|
608 |
case equal |
|
609 |
with 4 \<section> show ?thesis |
|
610 |
by (simp add: sparse_row_matrix_cons le_spvec_iff_sparse_row_le disj_matrices_commute disj_move_sparse_vec_mat[OF order_refl] disj_matrices_add) |
|
611 |
next |
|
612 |
case greater |
|
613 |
with 4 \<section> show ?thesis |
|
614 |
apply (simp add: sparse_row_matrix_cons le_spvec_empty1_sparse_row) |
|
615 |
by (metis disj_matrices_add_x disj_matrices_add_x_le disj_matrices_commute disj_move_sparse_row_vector_twice disj_move_sparse_vec_mat move_matrix_zero_le nat_int nat_less_le of_nat_0_le_iff order_refl) |
|
616 |
qed |
|
617 |
qed (auto simp add: sparse_row_matrix_cons disj_matrices_add_le_zero disj_matrices_add_zero_le disj_move_sparse_vec_mat[OF order_refl] |
|
618 |
disj_matrices_commute sorted_spvec_cons1 le_spvec_empty2_sparse_row le_spvec_empty1_sparse_row) |
|
15009 | 619 |
|
15178 | 620 |
|
38273 | 621 |
primrec abs_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat" |
622 |
where |
|
623 |
"abs_spmat [] = []" |
|
624 |
| "abs_spmat (a#as) = (fst a, abs_spvec (snd a))#(abs_spmat as)" |
|
15178 | 625 |
|
38273 | 626 |
primrec minus_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat" |
627 |
where |
|
628 |
"minus_spmat [] = []" |
|
629 |
| "minus_spmat (a#as) = (fst a, minus_spvec (snd a))#(minus_spmat as)" |
|
15178 | 630 |
|
631 |
lemma sparse_row_matrix_minus: |
|
632 |
"sparse_row_matrix (minus_spmat A) = - (sparse_row_matrix A)" |
|
80736 | 633 |
proof (induct A) |
634 |
case Nil |
|
635 |
then show ?case by auto |
|
636 |
next |
|
637 |
case (Cons a A) |
|
638 |
then show ?case |
|
639 |
by (simp add: sparse_row_vector_minus sparse_row_matrix_cons matrix_eqI) |
|
640 |
qed |
|
15009 | 641 |
|
80736 | 642 |
lemma Rep_sparse_row_vector_zero: |
643 |
assumes "x \<noteq> 0" |
|
644 |
shows "Rep_matrix (sparse_row_vector v) x y = 0" |
|
645 |
by (metis Suc_leI assms le0 le_eq_less_or_eq nrows_le nrows_spvec) |
|
15178 | 646 |
|
647 |
lemma sparse_row_matrix_abs: |
|
61945 | 648 |
"sorted_spvec A \<Longrightarrow> sorted_spmat A \<Longrightarrow> sparse_row_matrix (abs_spmat A) = \<bar>sparse_row_matrix A\<bar>" |
80736 | 649 |
proof (induct A) |
650 |
case Nil |
|
651 |
then show ?case by auto |
|
652 |
next |
|
653 |
case (Cons ab A) |
|
654 |
then have A: "sorted_spvec A" |
|
655 |
using sorted_spvec_cons1 by blast |
|
656 |
show ?case |
|
657 |
proof (cases ab) |
|
658 |
case (Pair a b) |
|
659 |
show ?thesis |
|
660 |
unfolding Pair |
|
661 |
proof (intro matrix_eqI) |
|
662 |
fix m n |
|
663 |
show "Rep_matrix (sparse_row_matrix (abs_spmat ((a,b) # A))) m n |
|
664 |
= Rep_matrix \<bar>sparse_row_matrix ((a,b) # A)\<bar> m n" |
|
665 |
using Cons Pair A |
|
666 |
apply (simp add: sparse_row_vector_abs sparse_row_matrix_cons) |
|
667 |
apply (cases "m=a") |
|
668 |
using sorted_sparse_row_matrix_zero apply fastforce |
|
669 |
by (simp add: Rep_sparse_row_vector_zero) |
|
670 |
qed |
|
671 |
qed |
|
672 |
qed |
|
15178 | 673 |
|
674 |
lemma sorted_spvec_minus_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (minus_spmat A)" |
|
80736 | 675 |
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps) |
15178 | 676 |
|
677 |
lemma sorted_spvec_abs_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (abs_spmat A)" |
|
80736 | 678 |
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps) |
15178 | 679 |
|
680 |
lemma sorted_spmat_minus_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (minus_spmat A)" |
|
80736 | 681 |
by (induct A) (simp_all add: sorted_spvec_minus_spvec) |
15178 | 682 |
|
683 |
lemma sorted_spmat_abs_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (abs_spmat A)" |
|
80736 | 684 |
by (induct A) (simp_all add: sorted_spvec_abs_spvec) |
15009 | 685 |
|
38273 | 686 |
definition diff_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" |
687 |
where "diff_spmat A B = add_spmat A (minus_spmat B)" |
|
15178 | 688 |
|
689 |
lemma sorted_spmat_diff_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spmat (diff_spmat A B)" |
|
690 |
by (simp add: diff_spmat_def sorted_spmat_minus_spmat sorted_spmat_add_spmat) |
|
691 |
||
692 |
lemma sorted_spvec_diff_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec B \<Longrightarrow> sorted_spvec (diff_spmat A B)" |
|
693 |
by (simp add: diff_spmat_def sorted_spvec_minus_spmat sorted_spvec_add_spmat) |
|
694 |
||
695 |
lemma sparse_row_diff_spmat: "sparse_row_matrix (diff_spmat A B ) = (sparse_row_matrix A) - (sparse_row_matrix B)" |
|
696 |
by (simp add: diff_spmat_def sparse_row_add_spmat sparse_row_matrix_minus) |
|
697 |
||
38273 | 698 |
definition sorted_sparse_matrix :: "'a spmat \<Rightarrow> bool" |
699 |
where "sorted_sparse_matrix A \<longleftrightarrow> sorted_spvec A & sorted_spmat A" |
|
15178 | 700 |
|
701 |
lemma sorted_sparse_matrix_imp_spvec: "sorted_sparse_matrix A \<Longrightarrow> sorted_spvec A" |
|
702 |
by (simp add: sorted_sparse_matrix_def) |
|
703 |
||
704 |
lemma sorted_sparse_matrix_imp_spmat: "sorted_sparse_matrix A \<Longrightarrow> sorted_spmat A" |
|
705 |
by (simp add: sorted_sparse_matrix_def) |
|
706 |
||
707 |
lemmas sorted_sp_simps = |
|
708 |
sorted_spvec.simps |
|
709 |
sorted_spmat.simps |
|
710 |
sorted_sparse_matrix_def |
|
711 |
||
712 |
lemma bool1: "(\<not> True) = False" by blast |
|
713 |
lemma bool2: "(\<not> False) = True" by blast |
|
61076 | 714 |
lemma bool3: "((P::bool) \<and> True) = P" by blast |
715 |
lemma bool4: "(True \<and> (P::bool)) = P" by blast |
|
716 |
lemma bool5: "((P::bool) \<and> False) = False" by blast |
|
717 |
lemma bool6: "(False \<and> (P::bool)) = False" by blast |
|
718 |
lemma bool7: "((P::bool) \<or> True) = True" by blast |
|
719 |
lemma bool8: "(True \<or> (P::bool)) = True" by blast |
|
720 |
lemma bool9: "((P::bool) \<or> False) = P" by blast |
|
721 |
lemma bool10: "(False \<or> (P::bool)) = P" by blast |
|
15178 | 722 |
lemmas boolarith = bool1 bool2 bool3 bool4 bool5 bool6 bool7 bool8 bool9 bool10 |
723 |
||
724 |
lemma if_case_eq: "(if b then x else y) = (case b of True => x | False => y)" by simp |
|
725 |
||
38273 | 726 |
primrec pprt_spvec :: "('a::{lattice_ab_group_add}) spvec \<Rightarrow> 'a spvec" |
727 |
where |
|
728 |
"pprt_spvec [] = []" |
|
729 |
| "pprt_spvec (a#as) = (fst a, pprt (snd a)) # (pprt_spvec as)" |
|
15580 | 730 |
|
38273 | 731 |
primrec nprt_spvec :: "('a::{lattice_ab_group_add}) spvec \<Rightarrow> 'a spvec" |
732 |
where |
|
15580 | 733 |
"nprt_spvec [] = []" |
38273 | 734 |
| "nprt_spvec (a#as) = (fst a, nprt (snd a)) # (nprt_spvec as)" |
15580 | 735 |
|
38273 | 736 |
primrec pprt_spmat :: "('a::{lattice_ab_group_add}) spmat \<Rightarrow> 'a spmat" |
737 |
where |
|
15580 | 738 |
"pprt_spmat [] = []" |
38273 | 739 |
| "pprt_spmat (a#as) = (fst a, pprt_spvec (snd a))#(pprt_spmat as)" |
15580 | 740 |
|
38273 | 741 |
primrec nprt_spmat :: "('a::{lattice_ab_group_add}) spmat \<Rightarrow> 'a spmat" |
742 |
where |
|
15580 | 743 |
"nprt_spmat [] = []" |
38273 | 744 |
| "nprt_spmat (a#as) = (fst a, nprt_spvec (snd a))#(nprt_spmat as)" |
15580 | 745 |
|
746 |
||
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
747 |
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
|
748 |
apply (simp add: pprt_def sup_matrix_def) |
80736 | 749 |
apply (intro matrix_eqI) |
750 |
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 | 751 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
752 |
lemma nprt_add: "disj_matrices A (B::(_::lattice_ring) matrix) \<Longrightarrow> nprt (A+B) = nprt A + nprt B" |
80736 | 753 |
unfolding nprt_def inf_matrix_def |
754 |
apply (intro matrix_eqI) |
|
755 |
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 | 756 |
|
80736 | 757 |
lemma pprt_singleton[simp]: |
758 |
fixes x:: "_::lattice_ring" |
|
759 |
shows "pprt (singleton_matrix j i x) = singleton_matrix j i (pprt x)" |
|
760 |
unfolding pprt_def sup_matrix_def |
|
761 |
by (simp add: matrix_eqI) |
|
15580 | 762 |
|
80736 | 763 |
lemma nprt_singleton[simp]: |
764 |
fixes x:: "_::lattice_ring" |
|
765 |
shows "nprt (singleton_matrix j i x) = singleton_matrix j i (nprt x)" |
|
766 |
by (metis add_left_imp_eq pprt_singleton prts singleton_matrix_add) |
|
15580 | 767 |
|
80736 | 768 |
lemma sparse_row_vector_pprt: |
769 |
fixes v:: "_::lattice_ring spvec" |
|
770 |
shows "sorted_spvec v \<Longrightarrow> sparse_row_vector (pprt_spvec v) = pprt (sparse_row_vector v)" |
|
771 |
proof (induct v rule: sorted_spvec.induct) |
|
772 |
case (3 m x n y bs) |
|
773 |
then show ?case |
|
80756 | 774 |
apply simp |
80736 | 775 |
apply (subst pprt_add) |
776 |
apply (metis disj_matrices_commute disj_sparse_row_singleton order.refl fst_conv prod.sel(2) sparse_row_vector_cons) |
|
777 |
by (metis pprt_singleton sorted_spvec_cons1) |
|
778 |
qed auto |
|
15580 | 779 |
|
80736 | 780 |
lemma sparse_row_vector_nprt: |
781 |
fixes v:: "_::lattice_ring spvec" |
|
782 |
shows "sorted_spvec v \<Longrightarrow> sparse_row_vector (nprt_spvec v) = nprt (sparse_row_vector v)" |
|
783 |
proof (induct v rule: sorted_spvec.induct) |
|
784 |
case (3 m x n y bs) |
|
785 |
then show ?case |
|
80756 | 786 |
apply simp |
80736 | 787 |
apply (subst nprt_add) |
788 |
apply (metis disj_matrices_commute disj_sparse_row_singleton dual_order.refl fst_conv prod.sel(2) sparse_row_vector_cons) |
|
789 |
using sorted_spvec_cons1 by force |
|
790 |
qed auto |
|
15580 | 791 |
|
792 |
||
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
793 |
lemma pprt_move_matrix: "pprt (move_matrix (A::('a::lattice_ring) matrix) j i) = move_matrix (pprt A) j i" |
80736 | 794 |
by (simp add: pprt_def sup_matrix_def matrix_eqI) |
15580 | 795 |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
796 |
lemma nprt_move_matrix: "nprt (move_matrix (A::('a::lattice_ring) matrix) j i) = move_matrix (nprt A) j i" |
80736 | 797 |
by (simp add: nprt_def inf_matrix_def matrix_eqI) |
15580 | 798 |
|
80736 | 799 |
lemma sparse_row_matrix_pprt: |
800 |
fixes m:: "'a::lattice_ring spmat" |
|
801 |
shows "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (pprt_spmat m) = pprt (sparse_row_matrix m)" |
|
802 |
proof (induct m rule: sorted_spvec.induct) |
|
803 |
case (2 a) |
|
804 |
then show ?case |
|
805 |
by (simp add: pprt_move_matrix sparse_row_matrix_cons sparse_row_vector_pprt) |
|
806 |
next |
|
807 |
case (3 m x n y bs) |
|
808 |
then show ?case |
|
809 |
apply (simp add: sparse_row_matrix_cons sparse_row_vector_pprt) |
|
810 |
apply (subst pprt_add) |
|
811 |
apply (subst disj_matrices_commute) |
|
812 |
apply (metis disj_move_sparse_vec_mat eq_imp_le fst_conv prod.sel(2) sparse_row_matrix_cons) |
|
813 |
apply (simp add: sorted_spvec.simps pprt_move_matrix) |
|
814 |
done |
|
815 |
qed auto |
|
15580 | 816 |
|
80736 | 817 |
lemma sparse_row_matrix_nprt: |
818 |
fixes m:: "'a::lattice_ring spmat" |
|
819 |
shows "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (nprt_spmat m) = nprt (sparse_row_matrix m)" |
|
820 |
proof (induct m rule: sorted_spvec.induct) |
|
821 |
case (2 a) |
|
822 |
then show ?case |
|
823 |
by (simp add: nprt_move_matrix sparse_row_matrix_cons sparse_row_vector_nprt) |
|
824 |
next |
|
825 |
case (3 m x n y bs) |
|
826 |
then show ?case |
|
827 |
apply (simp add: sparse_row_matrix_cons sparse_row_vector_nprt) |
|
828 |
apply (subst nprt_add) |
|
829 |
apply (subst disj_matrices_commute) |
|
830 |
apply (metis disj_move_sparse_vec_mat fst_conv nle_le prod.sel(2) sparse_row_matrix_cons) |
|
831 |
apply (simp add: sorted_spvec.simps nprt_move_matrix) |
|
832 |
done |
|
833 |
qed auto |
|
15580 | 834 |
|
835 |
lemma sorted_pprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (pprt_spvec v)" |
|
80736 | 836 |
proof (induct v rule: sorted_spvec.induct) |
837 |
case 1 |
|
838 |
then show ?case by auto |
|
839 |
next |
|
840 |
case (2 a) |
|
841 |
then show ?case |
|
842 |
by (simp add: sorted_spvec_step1) |
|
843 |
next |
|
844 |
case (3 m x n y bs) |
|
845 |
then show ?case |
|
846 |
by (simp add: sorted_spvec_step) |
|
847 |
qed |
|
15580 | 848 |
|
849 |
lemma sorted_nprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (nprt_spvec v)" |
|
80756 | 850 |
by (induct v rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm) |
15580 | 851 |
|
852 |
lemma sorted_spvec_pprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (pprt_spmat m)" |
|
80756 | 853 |
by (induct m rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm) |
15580 | 854 |
|
855 |
lemma sorted_spvec_nprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (nprt_spmat m)" |
|
80736 | 856 |
by (induct m rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm) |
15580 | 857 |
|
858 |
lemma sorted_spmat_pprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (pprt_spmat m)" |
|
80736 | 859 |
by (induct m) (simp_all add: sorted_pprt_spvec) |
15580 | 860 |
|
861 |
lemma sorted_spmat_nprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (nprt_spmat m)" |
|
80736 | 862 |
by (induct m) (simp_all add: sorted_nprt_spvec) |
15580 | 863 |
|
35416
d8d7d1b785af
replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
haftmann
parents:
35028
diff
changeset
|
864 |
definition mult_est_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" where |
38273 | 865 |
"mult_est_spmat r1 r2 s1 s2 = |
31816 | 866 |
add_spmat (mult_spmat (pprt_spmat s2) (pprt_spmat r2)) (add_spmat (mult_spmat (pprt_spmat s1) (nprt_spmat r2)) |
867 |
(add_spmat (mult_spmat (nprt_spmat s2) (pprt_spmat r1)) (mult_spmat (nprt_spmat s1) (nprt_spmat r1))))" |
|
15580 | 868 |
|
869 |
lemmas sparse_row_matrix_op_simps = |
|
870 |
sorted_sparse_matrix_imp_spmat sorted_sparse_matrix_imp_spvec |
|
871 |
sparse_row_add_spmat sorted_spvec_add_spmat sorted_spmat_add_spmat |
|
872 |
sparse_row_diff_spmat sorted_spvec_diff_spmat sorted_spmat_diff_spmat |
|
873 |
sparse_row_matrix_minus sorted_spvec_minus_spmat sorted_spmat_minus_spmat |
|
874 |
sparse_row_mult_spmat sorted_spvec_mult_spmat sorted_spmat_mult_spmat |
|
875 |
sparse_row_matrix_abs sorted_spvec_abs_spmat sorted_spmat_abs_spmat |
|
876 |
le_spmat_iff_sparse_row_le |
|
877 |
sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat |
|
878 |
sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat |
|
879 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46988
diff
changeset
|
880 |
lemmas sparse_row_matrix_arith_simps = |
15580 | 881 |
mult_spmat.simps mult_spvec_spmat.simps |
882 |
addmult_spvec.simps |
|
883 |
smult_spvec_empty smult_spvec_cons |
|
884 |
add_spmat.simps add_spvec.simps |
|
885 |
minus_spmat.simps minus_spvec.simps |
|
886 |
abs_spmat.simps abs_spvec.simps |
|
887 |
diff_spmat_def |
|
888 |
le_spmat.simps le_spvec.simps |
|
889 |
pprt_spmat.simps pprt_spvec.simps |
|
890 |
nprt_spmat.simps nprt_spvec.simps |
|
891 |
mult_est_spmat_def |
|
892 |
||
893 |
||
894 |
(*lemma spm_linprog_dual_estimate_1: |
|
15178 | 895 |
assumes |
896 |
"sorted_sparse_matrix A1" |
|
897 |
"sorted_sparse_matrix A2" |
|
898 |
"sorted_sparse_matrix c1" |
|
899 |
"sorted_sparse_matrix c2" |
|
900 |
"sorted_sparse_matrix y" |
|
901 |
"sorted_spvec b" |
|
902 |
"sorted_spvec r" |
|
903 |
"le_spmat ([], y)" |
|
35028
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents:
32491
diff
changeset
|
904 |
"A * x \<le> sparse_row_matrix (b::('a::lattice_ring) spmat)" |
80736 | 905 |
"sparse_row_matrix A1 \<le> A" |
906 |
"A \<le> sparse_row_matrix A2" |
|
907 |
"sparse_row_matrix c1 \<le> c" |
|
908 |
"c \<le> sparse_row_matrix c2" |
|
61945 | 909 |
"\<bar>x\<bar> \<le> sparse_row_matrix r" |
15178 | 910 |
shows |
911 |
"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), |
|
912 |
abs_spmat (diff_spmat (mult_spmat y A1) c1)), diff_spmat c2 c1)) r))" |
|
913 |
by (insert prems, simp add: sparse_row_matrix_op_simps linprog_dual_estimate_1[where A=A]) |
|
15580 | 914 |
*) |
15009 | 915 |
|
916 |
end |