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